kemonine/emacs
Archived
1
0
Fork 0
Code Activity

add magit packages

Browse source
This commit is contained in:
KemoNine 2022-04-25 18:51:31 -04:00
parent 64e65c2bf7
commit 2fe771c235
168 changed files with 121508 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
code/elpa/compat-28.1.1.0.signed Normal file
View file

@ -0,0 +1 @@
Good signature from 066DAFCB81E42C40 GNU ELPA Signing Agent (2019) <elpasign@elpa.gnu.org> (trust undefined) created at 2022-04-22T17:05:01-0400 using RSA

40
code/elpa/compat-28.1.1.0/NEWS.org Normal file
View file

@ -0,0 +1,40 @@
* Release of "Compat" Version 28.1.1.0
This release mostly fixes a number of smaller bugs that were not
identified as of 28.1.0.0. Nevertheless these warrent a version bump,
as some of these changes a functional. These include:
- The addition of the =file-attribute-*= accessor functions.
- The addition of =file-attribute-collect=.
- Improvements to the Texinfo manual (via Jonas Bernoulli's recent
work on =ox-texinfo=). For the time being, the Texinfo file is
maintained in the repository itself, next to the =MANUAL= file.
This might change in the future.
- Adding a prefix to =string-trim=, =string-trim-left= and
=string-trim-right= (i.e. now =compat-string-trim=,
=compat-string-trim-left= and =compat-string-trim-right=)
- Improving the version inference used in the =compat-*= macros.
This improves the compile-time optimisation that strips away
functions that are known to be defined for a specific version.
- The addition of generalised variable (=setf=) support for
=compat-alist-get=.
- The addition of =image-property= and generalised variable support
for =image-property=.
- The addition of the function =compat-executable-find=.
- The addition of the function =compat-dired-get-marked-files=.
- The addition of the function =exec-path=.
- The addition of the function =make-lock-file-name=.
- The addition of the function =null-device=.
- The addition of the function =time-equal-p=.
- The addition of the function =date-days-in-month=.
- Handling out-of-directory byte compilation better.
- Fixing the usage and edge-cases of =and-let*=.
Furthermore a bug tracker was added: https://todo.sr.ht/~pkal/compat,
which is the preferred way to report issues or feature requests.
General problems, questions, etc. are still better discussed on the
development mailing list: https://lists.sr.ht/~pkal/compat-devel.
(Released <2022-04-22 Fri>)

516
code/elpa/compat-28.1.1.0/compat-24.el Normal file
View file

@ -0,0 +1,516 @@
;;; compat-24.el --- Compatibility Layer for Emacs 24.4 -*- lexical-binding: t; -*-
;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
;; Author: Philip Kaludercic <philipk@posteo.net>
;; Maintainer: Compat Development <~pkal/compat-devel@lists.sr.ht>
;; URL: https://git.sr.ht/~pkal/compat/
;; Keywords: lisp
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Find here the functionality added in Emacs 24.4, needed by older
;; versions.
;;
;; Do NOT load this library manually. Instead require `compat'.
;;; Code:
(eval-when-compile (require 'compat-macs))
;;;; Defined in data.c
(compat-defun = (number-or-marker &rest numbers-or-markers)
"Handle multiple arguments."
:version "24.4"
:prefix t
(catch 'fail
(while numbers-or-markers
(unless (= number-or-marker (car numbers-or-markers))
(throw 'fail nil))
(setq number-or-marker (pop numbers-or-markers)))
t))
(compat-defun < (number-or-marker &rest numbers-or-markers)
"Handle multiple arguments."
:version "24.4"
:prefix t
(catch 'fail
(while numbers-or-markers
(unless (< number-or-marker (car numbers-or-markers))
(throw 'fail nil))
(setq number-or-marker (pop numbers-or-markers)))
t))
(compat-defun > (number-or-marker &rest numbers-or-markers)
"Handle multiple arguments."
:version "24.4"
:prefix t
(catch 'fail
(while numbers-or-markers
(unless (> number-or-marker (car numbers-or-markers))
(throw 'fail nil))
(setq number-or-marker (pop numbers-or-markers)))
t))
(compat-defun <= (number-or-marker &rest numbers-or-markers)
"Handle multiple arguments."
:version "24.4"
:prefix t
(catch 'fail
(while numbers-or-markers
(unless (<= number-or-marker (car numbers-or-markers))
(throw 'fail nil))
(setq number-or-marker (pop numbers-or-markers)))
t))
(compat-defun >= (number-or-marker &rest numbers-or-markers)
"Handle multiple arguments."
:version "24.4"
:prefix t
(catch 'fail
(while numbers-or-markers
(unless (>= number-or-marker (pop numbers-or-markers))
(throw 'fail nil)))
t))
(compat-defun bool-vector-exclusive-or (a b &optional c)
"Return A ^ B, bitwise exclusive or.
If optional third argument C is given, store result into C.
A, B, and C must be bool vectors of the same length.
Return the destination vector if it changed or nil otherwise."
:version "24.4"
(unless (bool-vector-p a)
(signal 'wrong-type-argument (list 'bool-vector-p a)))
(unless (bool-vector-p b)
(signal 'wrong-type-argument (list 'bool-vector-p b)))
(unless (or (null c) (bool-vector-p c))
(signal 'wrong-type-argument (list 'bool-vector-p c)))
(when (/= (length a) (length b))
(signal 'wrong-length-argument (list (length a) (length b))))
(let ((dest (or c (make-bool-vector (length a) nil))) changed)
(when (/= (length a) (length dest))
(signal 'wrong-length-argument (list (length a) (length dest))))
(dotimes (i (length dest))
(let ((val (not (eq (aref a i) (aref b i)))))
(unless (eq val (aref dest i))
(setq changed t))
(aset dest i val)))
(if c (and changed c) dest)))
(compat-defun bool-vector-union (a b &optional c)
"Return A | B, bitwise or.
If optional third argument C is given, store result into C.
A, B, and C must be bool vectors of the same length.
Return the destination vector if it changed or nil otherwise."
:version "24.4"
(unless (bool-vector-p a)
(signal 'wrong-type-argument (list 'bool-vector-p a)))
(unless (bool-vector-p b)
(signal 'wrong-type-argument (list 'bool-vector-p b)))
(unless (or (null c) (bool-vector-p c))
(signal 'wrong-type-argument (list 'bool-vector-p c)))
(when (/= (length a) (length b))
(signal 'wrong-length-argument (list (length a) (length b))))
(let ((dest (or c (make-bool-vector (length a) nil))) changed)
(when (/= (length a) (length dest))
(signal 'wrong-length-argument (list (length a) (length dest))))
(dotimes (i (length dest))
(let ((val (or (aref a i) (aref b i))))
(unless (eq val (aref dest i))
(setq changed t))
(aset dest i val)))
(if c (and changed c) dest)))
(compat-defun bool-vector-intersection (a b &optional c)
"Return A & B, bitwise and.
If optional third argument C is given, store result into C.
A, B, and C must be bool vectors of the same length.
Return the destination vector if it changed or nil otherwise."
:version "24.4"
(unless (bool-vector-p a)
(signal 'wrong-type-argument (list 'bool-vector-p a)))
(unless (bool-vector-p b)
(signal 'wrong-type-argument (list 'bool-vector-p b)))
(unless (or (null c) (bool-vector-p c))
(signal 'wrong-type-argument (list 'bool-vector-p c)))
(when (/= (length a) (length b))
(signal 'wrong-length-argument (list (length a) (length b))))
(let ((dest (or c (make-bool-vector (length a) nil))) changed)
(when (/= (length a) (length dest))
(signal 'wrong-length-argument (list (length a) (length dest))))
(dotimes (i (length dest))
(let ((val (and (aref a i) (aref b i))))
(unless (eq val (aref dest i))
(setq changed t))
(aset dest i val)))
(if c (and changed c) dest)))
(compat-defun bool-vector-set-difference (a b &optional c)
"Return A &~ B, set difference.
If optional third argument C is given, store result into C.
A, B, and C must be bool vectors of the same length.
Return the destination vector if it changed or nil otherwise."
:version "24.4"
(unless (bool-vector-p a)
(signal 'wrong-type-argument (list 'bool-vector-p a)))
(unless (bool-vector-p b)
(signal 'wrong-type-argument (list 'bool-vector-p b)))
(unless (or (null c) (bool-vector-p c))
(signal 'wrong-type-argument (list 'bool-vector-p c)))
(when (/= (length a) (length b))
(signal 'wrong-length-argument (list (length a) (length b))))
(let ((dest (or c (make-bool-vector (length a) nil))) changed)
(when (/= (length a) (length dest))
(signal 'wrong-length-argument (list (length a) (length dest))))
(dotimes (i (length dest))
(let ((val (and (aref a i) (not (aref b i)))))
(unless (eq val (aref dest i))
(setq changed t))
(aset dest i val)))
(if c (and changed c) dest)))
(compat-defun bool-vector-not (a &optional b)
"Compute ~A, set complement.
If optional second argument B is given, store result into B.
A and B must be bool vectors of the same length.
Return the destination vector."
:version "24.4"
(unless (bool-vector-p a)
(signal 'wrong-type-argument (list 'bool-vector-p a)))
(unless (or (null b) (bool-vector-p b))
(signal 'wrong-type-argument (list 'bool-vector-p b)))
(let ((dest (or b (make-bool-vector (length a) nil))))
(when (/= (length a) (length dest))
(signal 'wrong-length-argument (list (length a) (length dest))))
(dotimes (i (length dest))
(aset dest i (not (aref a i))))
dest))
(compat-defun bool-vector-subsetp (a b)
"Return t if every t value in A is also t in B, nil otherwise.
A and B must be bool vectors of the same length."
:version "24.4"
(unless (bool-vector-p a)
(signal 'wrong-type-argument (list 'bool-vector-p a)))
(unless (bool-vector-p b)
(signal 'wrong-type-argument (list 'bool-vector-p b)))
(when (/= (length a) (length b))
(signal 'wrong-length-argument (list (length a) (length b))))
(catch 'not-subset
(dotimes (i (length a))
(when (if (aref a i) (not (aref b i)) nil)
(throw 'not-subset nil)))
t))
(compat-defun bool-vector-count-consecutive (a b i)
"Count how many consecutive elements in A equal B starting at I.
A is a bool vector, B is t or nil, and I is an index into A."
:version "24.4"
(unless (bool-vector-p a)
(signal 'wrong-type-argument (list 'bool-vector-p a)))
(setq b (and b t)) ;normalise to nil or t
(unless (< i (length a))
(signal 'args-out-of-range (list a i)))
(let ((len (length a)) (n i))
(while (and (< i len) (eq (aref a i) b))
(setq i (1+ i)))
(- i n)))
(compat-defun bool-vector-count-population (a)
"Count how many elements in A are t.
A is a bool vector. To count A's nil elements, subtract the
return value from A's length."
:version "24.4"
(unless (bool-vector-p a)
(signal 'wrong-type-argument (list 'bool-vector-p a)))
(let ((n 0))
(dotimes (i (length a))
(when (aref a i)
(setq n (1+ n))))
n))
;;;; Defined in subr.el
;;* UNTESTED
(compat-defmacro with-eval-after-load (file &rest body)
"Execute BODY after FILE is loaded.
FILE is normally a feature name, but it can also be a file name,
in case that file does not provide any feature. See `eval-after-load'
for more details about the different forms of FILE and their semantics."
:version "24.4"
(declare (indent 1) (debug (form def-body)))
;; See https://nullprogram.com/blog/2018/02/22/ on how
;; `eval-after-load' is used to preserve compatibility with 24.3.
`(eval-after-load ,file `(funcall ',,`(lambda () ,@body))))
(compat-defun special-form-p (object)
"Non-nil if and only if OBJECT is a special form."
:version "24.4"
(if (and (symbolp object) (fboundp object))
(setq object (condition-case nil
(indirect-function object)
(void-function nil))))
(and (subrp object) (eq (cdr (subr-arity object)) 'unevalled)))
(compat-defun macrop (object)
"Non-nil if and only if OBJECT is a macro."
:version "24.4"
(let ((def (condition-case nil
(indirect-function object)
(void-function nil))))
(when (consp def)
(or (eq 'macro (car def))
(and (autoloadp def) (memq (nth 4 def) '(macro t)))))))
(compat-defun string-suffix-p (suffix string &optional ignore-case)
"Return non-nil if SUFFIX is a suffix of STRING.
If IGNORE-CASE is non-nil, the comparison is done without paying
attention to case differences."
:version "24.4"
(let ((start-pos (- (length string) (length suffix))))
(and (>= start-pos 0)
(eq t (compare-strings suffix nil nil
string start-pos nil ignore-case)))))
(compat-defun split-string (string &optional separators omit-nulls trim)
"Extend `split-string' by a TRIM argument.
The remaining arguments STRING, SEPARATORS and OMIT-NULLS are
handled just as with `split-string'."
:version "24.4"
:prefix t
(let* ((token (split-string string separators omit-nulls))
(trimmed (if trim
(mapcar
(lambda (token)
(when (string-match (concat "\\`" trim) token)
(setq token (substring token (match-end 0))))
(when (string-match (concat trim "\\'") token)
(setq token (substring token 0 (match-beginning 0))))
token)
token)
token)))
(if omit-nulls (delete "" trimmed) trimmed)))
(compat-defun delete-consecutive-dups (list &optional circular)
"Destructively remove `equal' consecutive duplicates from LIST.
First and last elements are considered consecutive if CIRCULAR is
non-nil."
:version "24.4"
(let ((tail list) last)
(while (cdr tail)
(if (equal (car tail) (cadr tail))
(setcdr tail (cddr tail))
(setq last tail
tail (cdr tail))))
(if (and circular
last
(equal (car tail) (car list)))
(setcdr last nil)))
list)
;;* UNTESTED
(compat-defun define-error (name message &optional parent)
"Define NAME as a new error signal.
MESSAGE is a string that will be output to the echo area if such an error
is signaled without being caught by a `condition-case'.
PARENT is either a signal or a list of signals from which it inherits.
Defaults to `error'."
:version "24.4"
(unless parent (setq parent 'error))
(let ((conditions
(if (consp parent)
(apply #'append
(mapcar (lambda (parent)
(cons parent
(or (get parent 'error-conditions)
(error "Unknown signal `%s'" parent))))
parent))
(cons parent (get parent 'error-conditions)))))
(put name 'error-conditions
(delete-dups (copy-sequence (cons name conditions))))
(when message (put name 'error-message message))))
;;;; Defined in minibuffer.el
;;* UNTESTED
(compat-defun completion-table-with-cache (fun &optional ignore-case)
"Create dynamic completion table from function FUN, with cache.
This is a wrapper for `completion-table-dynamic' that saves the last
argument-result pair from FUN, so that several lookups with the
same argument (or with an argument that starts with the first one)
only need to call FUN once. This can be useful when FUN performs a
relatively slow operation, such as calling an external process.
When IGNORE-CASE is non-nil, FUN is expected to be case-insensitive."
:version "24.4"
(let* (last-arg last-result
(new-fun
(lambda (arg)
(if (and last-arg (string-prefix-p last-arg arg ignore-case))
last-result
(prog1
(setq last-result (funcall fun arg))
(setq last-arg arg))))))
(completion-table-dynamic new-fun)))
;;* UNTESTED
(compat-defun completion-table-merge (&rest tables)
"Create a completion table that collects completions from all TABLES."
:version "24.4"
(lambda (string pred action)
(cond
((null action)
(let ((retvals (mapcar (lambda (table)
(try-completion string table pred))
tables)))
(if (member string retvals)
string
(try-completion string
(mapcar (lambda (value)
(if (eq value t) string value))
(delq nil retvals))
pred))))
((eq action t)
(apply #'append (mapcar (lambda (table)
(all-completions string table pred))
tables)))
(t
(completion--some (lambda (table)
(complete-with-action action table string pred))
tables)))))
;;;; Defined in subr-x.el
;;* UNTESTED
(compat-advise require (feature &rest args)
"Allow for Emacs 24.x to require the inexistent FEATURE subr-x."
:version "24.4"
;; As the compatibility advise around `require` is more a hack than
;; of of actual value, the highlighting is suppressed.
:no-highlight t
(if (eq feature 'subr-x)
(let ((entry (assq feature after-load-alist)))
(let ((load-file-name nil))
(dolist (form (cdr entry))
(funcall (eval form t)))))
(apply oldfun feature args)))
(compat-defun hash-table-keys (hash-table)
"Return a list of keys in HASH-TABLE."
:version "24.4"
(let (values)
(maphash
(lambda (k _v) (push k values))
hash-table)
values))
(compat-defun hash-table-values (hash-table)
"Return a list of values in HASH-TABLE."
:version "24.4"
(let (values)
(maphash
(lambda (_k v) (push v values))
hash-table)
values))
(compat-defun string-empty-p (string)
"Check whether STRING is empty."
:version "24.4"
(string= string ""))
(compat-defun string-join (strings &optional separator)
"Join all STRINGS using SEPARATOR.
Optional argument SEPARATOR must be a string, a vector, or a list of
characters; nil stands for the empty string."
:version "24.4"
(mapconcat #'identity strings separator))
(compat-defun string-blank-p (string)
"Check whether STRING is either empty or only whitespace.
The following characters count as whitespace here: space, tab, newline and
carriage return."
:version "24.4"
(string-match-p "\\`[ \t\n\r]*\\'" string))
(compat-defun string-remove-prefix (prefix string)
"Remove PREFIX from STRING if present."
:version "24.4"
(if (string-prefix-p prefix string)
(substring string (length prefix))
string))
(compat-defun string-remove-suffix (suffix string)
"Remove SUFFIX from STRING if present."
:version "24.4"
(if (string-suffix-p suffix string)
(substring string 0 (- (length string) (length suffix)))
string))
;;;; Defined in faces.el
;;* UNTESTED
(compat-defun face-spec-set (face spec &optional spec-type)
"Set the FACE's spec SPEC, define FACE, and recalculate its attributes.
See `defface' for the format of SPEC.
The appearance of each face is controlled by its specs (set via
this function), and by the internal frame-specific face
attributes (set via `set-face-attribute').
This function also defines FACE as a valid face name if it is not
already one, and (re)calculates its attributes on existing
frames.
The optional argument SPEC-TYPE determines which spec to set:
nil, omitted or `face-override-spec' means the override spec,
which overrides all the other types of spec mentioned below
(this is usually what you want if calling this function
outside of Custom code);
`customized-face' or `saved-face' means the customized spec or
the saved custom spec;
`face-defface-spec' means the default spec
(usually set only via `defface');
`reset' means to ignore SPEC, but clear the `customized-face'
and `face-override-spec' specs;
Any other value means not to set any spec, but to run the
function for defining FACE and recalculating its attributes."
:version "24.4"
(if (get face 'face-alias)
(setq face (get face 'face-alias)))
;; Save SPEC to the relevant symbol property.
(unless spec-type
(setq spec-type 'face-override-spec))
(if (memq spec-type '(face-defface-spec face-override-spec
customized-face saved-face))
(put face spec-type spec))
(if (memq spec-type '(reset saved-face))
(put face 'customized-face nil))
;; Setting the face spec via Custom empties out any override spec,
;; similar to how setting a variable via Custom changes its values.
(if (memq spec-type '(customized-face saved-face reset))
(put face 'face-override-spec nil))
;; If we reset the face based on its custom spec, it is unmodified
;; as far as Custom is concerned.
(unless (eq face 'face-override-spec)
(put face 'face-modified nil))
;; Initialize the face if it does not exist, then recalculate.
(make-empty-face face)
(dolist (frame (frame-list))
(face-spec-recalc face frame)))
(provide 'compat-24)
;;; compat-24.el ends here

317
code/elpa/compat-28.1.1.0/compat-25.el Normal file
View file

@ -0,0 +1,317 @@
;;; compat-25.el --- Compatibility Layer for Emacs 25.1 -*- lexical-binding: t; -*-
;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
;; Author: Philip Kaludercic <philipk@posteo.net>
;; Maintainer: Compat Development <~pkal/compat-devel@lists.sr.ht>
;; URL: https://git.sr.ht/~pkal/compat/
;; Keywords: lisp
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Find here the functionality added in Emacs 25.1, needed by older
;; versions.
;;
;; Do NOT load this library manually. Instead require `compat'.
;;; Code:
(eval-when-compile (require 'compat-macs))
;;;; Defined in alloc.c
(compat-defun bool-vector (&rest objects)
"Return a new bool-vector with specified arguments as elements.
Allows any number of arguments, including zero.
usage: (bool-vector &rest OBJECTS)"
(let ((vec (make-bool-vector (length objects) nil))
(i 0))
(while objects
(when (car objects)
(aset vec i t))
(setq objects (cdr objects)
i (1+ i)))
vec))
;;;; Defined in fns.c
(compat-defun sort (seq predicate)
"Extend `sort' to sort SEQ as a vector."
:prefix t
(cond
((listp seq)
(sort seq predicate))
((vectorp seq)
(let ((cseq (sort (append seq nil) predicate)))
(dotimes (i (length cseq))
(setf (aref seq i) (nth i cseq)))
(apply #'vector cseq)))
((signal 'wrong-type-argument 'list-or-vector-p))))
;;;; Defined in editfns.c
(compat-defun format-message (string &rest objects)
"Format a string out of a format-string and arguments.
The first argument is a format control string.
The other arguments are substituted into it to make the result, a string.
This implementation is equivalent to `format'."
(apply #'format string objects))
;;;; Defined in minibuf.c
;; TODO advise read-buffer to handle 4th argument
;;;; Defined in fileio.c
(compat-defun directory-name-p (name)
"Return non-nil if NAME ends with a directory separator character."
:realname compat--directory-name-p
(eq (eval-when-compile
(if (memq system-type '(cygwin windows-nt ms-dos))
?\\ ?/))
(aref name (1- (length name)))))
;;;; Defined in subr.el
(compat-defun string-greaterp (string1 string2)
"Return non-nil if STRING1 is greater than STRING2 in lexicographic order.
Case is significant.
Symbols are also allowed; their print names are used instead."
(string-lessp string2 string1))
;;* UNTESTED
(compat-defmacro with-file-modes (modes &rest body)
"Execute BODY with default file permissions temporarily set to MODES.
MODES is as for `set-default-file-modes'."
(declare (indent 1) (debug t))
(let ((umask (make-symbol "umask")))
`(let ((,umask (default-file-modes)))
(unwind-protect
(progn
(set-default-file-modes ,modes)
,@body)
(set-default-file-modes ,umask)))))
(compat-defun alist-get (key alist &optional default remove testfn)
"Find the first element of ALIST whose `car' equals KEY and return its `cdr'.
If KEY is not found in ALIST, return DEFAULT.
Equality with KEY is tested by TESTFN, defaulting to `eq'."
:realname compat--alist-get-full-elisp
(ignore remove)
(let (entry)
(cond
((or (null testfn) (eq testfn 'eq))
(setq entry (assq key alist)))
((eq testfn 'equal)
(setq entry (assoc key alist)))
((catch 'found
(dolist (ent alist)
(when (and (consp ent) (funcall testfn (car ent) key))
(throw 'found (setq entry ent))))
default)))
(if entry (cdr entry) default)))
;;;; Defined in subr-x.el
(compat-defmacro if-let (spec then &rest else)
"Bind variables according to SPEC and evaluate THEN or ELSE.
Evaluate each binding in turn, as in `let*', stopping if a
binding value is nil. If all are non-nil return the value of
THEN, otherwise the last form in ELSE.
Each element of SPEC is a list (SYMBOL VALUEFORM) that binds
SYMBOL to the value of VALUEFORM. An element can additionally be
of the form (VALUEFORM), which is evaluated and checked for nil;
i.e. SYMBOL can be omitted if only the test result is of
interest. It can also be of the form SYMBOL, then the binding of
SYMBOL is checked for nil.
As a special case, interprets a SPEC of the form \(SYMBOL SOMETHING)
like \((SYMBOL SOMETHING)). This exists for backward compatibility
with an old syntax that accepted only one binding."
:realname compat--if-let
:feature 'subr-x
(declare (indent 2)
(debug ([&or (symbolp form)
(&rest [&or symbolp (symbolp form) (form)])]
body)))
(when (and (<= (length spec) 2)
(not (listp (car spec))))
;; Adjust the single binding case
(setq spec (list spec)))
`(compat--if-let* ,spec ,then ,(macroexp-progn else)))
(compat-defmacro when-let (spec &rest body)
"Bind variables according to SPEC and conditionally evaluate BODY.
Evaluate each binding in turn, stopping if a binding value is nil.
If all are non-nil, return the value of the last form in BODY.
The variable list SPEC is the same as in `if-let'."
:feature 'subr-x
(declare (indent 1) (debug if-let))
`(compat--if-let ,spec ,(macroexp-progn body)))
(compat-defmacro thread-first (&rest forms)
"Thread FORMS elements as the first argument of their successor.
Example:
(thread-first
5
(+ 20)
(/ 25)
-
(+ 40))
Is equivalent to:
(+ (- (/ (+ 5 20) 25)) 40)
Note how the single `-' got converted into a list before
threading."
:feature 'subr-x
(declare (indent 1)
(debug (form &rest [&or symbolp (sexp &rest form)])))
(let ((body (car forms)))
(dolist (form (cdr forms))
(when (symbolp form)
(setq form (list form)))
(setq body (append (list (car form))
(list body)
(cdr form))))
body))
(compat-defmacro thread-last (&rest forms)
"Thread FORMS elements as the last argument of their successor.
Example:
(thread-last
5
(+ 20)
(/ 25)
-
(+ 40))
Is equivalent to:
(+ 40 (- (/ 25 (+ 20 5))))
Note how the single `-' got converted into a list before
threading."
:feature 'subr-x
(declare (indent 1) (debug thread-first))
(let ((body (car forms)))
(dolist (form (cdr forms))
(when (symbolp form)
(setq form (list form)))
(setq body (append form (list body))))
body))
;;;; Defined in macroexp.el
(declare-function macrop nil (object))
(compat-defun macroexpand-1 (form &optional environment)
"Perform (at most) one step of macro expansion."
:feature 'macroexp
(cond
((consp form)
(let* ((head (car form))
(env-expander (assq head environment)))
(if env-expander
(if (cdr env-expander)
(apply (cdr env-expander) (cdr form))
form)
(if (not (and (symbolp head) (fboundp head)))
form
(let ((def (autoload-do-load (symbol-function head) head 'macro)))
(cond
;; Follow alias, but only for macros, otherwise we may end up
;; skipping an important compiler-macro (e.g. cl--block-wrapper).
((and (symbolp def) (macrop def)) (cons def (cdr form)))
((not (consp def)) form)
(t
(if (eq 'macro (car def))
(apply (cdr def) (cdr form))
form))))))))
(t form)))
;;;; Defined in byte-run.el
;;* UNTESTED
(compat-defun function-put (func prop value)
"Set FUNCTION's property PROP to VALUE.
The namespace for PROP is shared with symbols.
So far, FUNCTION can only be a symbol, not a lambda expression."
:version "24.4"
(put func prop value))
;;;; Defined in files.el
;;* UNTESTED
(compat-defun directory-files-recursively
(dir regexp &optional include-directories predicate follow-symlinks)
"Return list of all files under directory DIR whose names match REGEXP.
This function works recursively. Files are returned in \"depth
first\" order, and files from each directory are sorted in
alphabetical order. Each file name appears in the returned list
in its absolute form.
By default, the returned list excludes directories, but if
optional argument INCLUDE-DIRECTORIES is non-nil, they are
included.
PREDICATE can be either nil (which means that all subdirectories
of DIR are descended into), t (which means that subdirectories that
can't be read are ignored), or a function (which is called with
the name of each subdirectory, and should return non-nil if the
subdirectory is to be descended into).
If FOLLOW-SYMLINKS is non-nil, symbolic links that point to
directories are followed. Note that this can lead to infinite
recursion."
:realname compat--directory-files-recursively
(let* ((result nil)
(files nil)
(dir (directory-file-name dir))
;; When DIR is "/", remote file names like "/method:" could
;; also be offered. We shall suppress them.
(tramp-mode (and tramp-mode (file-remote-p (expand-file-name dir)))))
(dolist (file (sort (file-name-all-completions "" dir)
'string<))
(unless (member file '("./" "../"))
(if (directory-name-p file)
(let* ((leaf (substring file 0 (1- (length file))))
(full-file (concat dir "/" leaf)))
;; Don't follow symlinks to other directories.
(when (and (or (not (file-symlink-p full-file))
(and (file-symlink-p full-file)
follow-symlinks))
;; Allow filtering subdirectories.
(or (eq predicate nil)
(eq predicate t)
(funcall predicate full-file)))
(let ((sub-files
(if (eq predicate t)
(condition-case nil
(compat--directory-files-recursively
full-file regexp include-directories
predicate follow-symlinks)
(file-error nil))
(compat--directory-files-recursively
full-file regexp include-directories
predicate follow-symlinks))))
(setq result (nconc result sub-files))))
(when (and include-directories
(string-match regexp leaf))
(setq result (nconc result (list full-file)))))
(when (string-match regexp file)
(push (concat dir "/" file) files)))))
(nconc result (nreverse files))))
(provide 'compat-25)
;;; compat-25.el ends here

623
code/elpa/compat-28.1.1.0/compat-26.el Normal file
View file

@ -0,0 +1,623 @@
;;; compat-26.el --- Compatibility Layer for Emacs 26.1 -*- lexical-binding: t; -*-
;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
;; Author: Philip Kaludercic <philipk@posteo.net>
;; Maintainer: Compat Development <~pkal/compat-devel@lists.sr.ht>
;; URL: https://git.sr.ht/~pkal/compat/
;; Keywords: lisp
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Find here the functionality added in Emacs 26.1, needed by older
;; versions.
;;
;; Do NOT load this library manually. Instead require `compat'.
;;; Code:
(eval-when-compile (require 'compat-macs))
(declare-function compat-func-arity "compat" (func))
;;;; Defined in eval.c
(compat-defun func-arity (func)
"Return minimum and maximum number of args allowed for FUNC.
FUNC must be a function of some kind.
The returned value is a cons cell (MIN . MAX). MIN is the minimum number
of args. MAX is the maximum number, or the symbol ‘many’, for a
function with ‘&rest’ args, or ‘unevalled’ for a special form."
:realname compat--func-arity
(cond
((or (null func) (and (symbolp func) (not (fboundp func))))
(signal 'void-function func))
((and (symbolp func) (not (null func)))
(compat--func-arity (symbol-function func)))
((eq (car-safe func) 'macro)
(compat--func-arity (cdr func)))
((subrp func)
(subr-arity func))
((memq (car-safe func) '(closure lambda))
;; See lambda_arity from eval.c
(when (eq (car func) 'closure)
(setq func (cdr func)))
(let ((syms-left (if (consp func)
(car func)
(signal 'invalid-function func)))
(min-args 0) (max-args 0) optional)
(catch 'many
(dolist (next syms-left)
(cond
((not (symbolp next))
(signal 'invalid-function func))
((eq next '&rest)
(throw 'many (cons min-args 'many)))
((eq next '&optional)
(setq optional t))
(t (unless optional
(setq min-args (1+ min-args)))
(setq max-args (1+ max-args)))))
(cons min-args max-args))))
((and (byte-code-function-p func) (numberp (aref func 0)))
;; See get_byte_code_arity from bytecode.c
(let ((at (aref func 0)))
(cons (logand at 127)
(if (= (logand at 128) 0)
(ash at -8)
'many))))
((and (byte-code-function-p func) (numberp (aref func 0)))
;; See get_byte_code_arity from bytecode.c
(let ((at (aref func 0)))
(cons (logand at 127)
(if (= (logand at 128) 0)
(ash at -8)
'many))))
((and (byte-code-function-p func) (listp (aref func 0)))
;; Based on `byte-compile-make-args-desc', this is required for
;; old versions of Emacs that don't use a integer for the argument
;; list description, per e2abe5a13dffb08d6371b6a611bc39c3a9ac2bc6.
(let ((arglist (aref func 0)) (mandatory 0) nonrest)
(while (and arglist (not (memq (car arglist) '(&optional &rest))))
(setq mandatory (1+ mandatory))
(setq arglist (cdr arglist)))
(setq nonrest mandatory)
(when (eq (car arglist) '&optional)
(setq arglist (cdr arglist))
(while (and arglist (not (eq (car arglist) '&rest)))
(setq nonrest (1+ nonrest))
(setq arglist (cdr arglist))))
(cons mandatory (if arglist 'many nonrest))))
((autoloadp func)
(autoload-do-load func)
(compat--func-arity func))
((signal 'invalid-function func))))
;;;; Defined in fns.c
(compat-defun assoc (key alist &optional testfn)
"Handle the optional argument TESTFN.
Equality is defined by the function TESTFN, defaulting to
‘equal’. TESTFN is called with 2 arguments: a car of an alist
element and KEY. With no optional argument, the function behaves
just like `assoc'."
:prefix t
(if testfn
(catch 'found
(dolist (ent alist)
(when (funcall testfn (car ent) key)
(throw 'found ent))))
(assoc key alist)))
(compat-defun mapcan (func sequence)
"Apply FUNC to each element of SEQUENCE.
Concatenate the results by altering them (using `nconc').
SEQUENCE may be a list, a vector, a boolean vector, or a string."
(apply #'nconc (mapcar func sequence)))
;;* UNTESTED
(compat-defun line-number-at-pos (&optional position absolute)
"Handle optional argument ABSOLUTE:
If the buffer is narrowed, the return value by default counts the lines
from the beginning of the accessible portion of the buffer. But if the
second optional argument ABSOLUTE is non-nil, the value counts the lines
from the absolute start of the buffer, disregarding the narrowing."
:prefix t
(if absolute
(save-restriction
(widen)
(line-number-at-pos position))
(line-number-at-pos position)))
;;;; Defined in subr.el
(declare-function compat--alist-get-full-elisp "compat-25"
(key alist &optional default remove testfn))
(compat-defun alist-get (key alist &optional default remove testfn)
"Handle TESTFN manually."
:realname compat--alist-get-handle-testfn
:prefix t
(if testfn
(compat--alist-get-full-elisp key alist default remove testfn)
(alist-get key alist default remove)))
(gv-define-expander compat-alist-get
(lambda (do key alist &optional default remove testfn)
(macroexp-let2 macroexp-copyable-p k key
(gv-letplace (getter setter) alist
(macroexp-let2 nil p `(if (and ,testfn (not (eq ,testfn 'eq)))
(compat-assoc ,k ,getter ,testfn)
(assq ,k ,getter))
(funcall do (if (null default) `(cdr ,p)
`(if ,p (cdr ,p) ,default))
(lambda (v)
(macroexp-let2 nil v v
(let ((set-exp
`(if ,p (setcdr ,p ,v)
,(funcall setter
`(cons (setq ,p (cons ,k ,v))
,getter)))))
`(progn
,(cond
((null remove) set-exp)
((or (eql v default)
(and (eq (car-safe v) 'quote)
(eq (car-safe default) 'quote)
(eql (cadr v) (cadr default))))
`(if ,p ,(funcall setter `(delq ,p ,getter))))
(t
`(cond
((not (eql ,default ,v)) ,set-exp)
(,p ,(funcall setter
`(delq ,p ,getter))))))
,v))))))))))
(compat-defun string-trim-left (string &optional regexp)
"Trim STRING of leading string matching REGEXP.
REGEXP defaults to \"[ \\t\\n\\r]+\"."
:realname compat--string-trim-left
:prefix t
(if (string-match (concat "\\`\\(?:" (or regexp "[ \t\n\r]+") "\\)") string)
(substring string (match-end 0))
string))
(compat-defun string-trim-right (string &optional regexp)
"Trim STRING of trailing string matching REGEXP.
REGEXP defaults to \"[ \\t\\n\\r]+\"."
:realname compat--string-trim-right
:prefix t
(let ((i (string-match-p
(concat "\\(?:" (or regexp "[ \t\n\r]+") "\\)\\'")
string)))
(if i (substring string 0 i) string)))
(compat-defun string-trim (string &optional trim-left trim-right)
"Trim STRING of leading with and trailing matching TRIM-LEFT and TRIM-RIGHT.
TRIM-LEFT and TRIM-RIGHT default to \"[ \\t\\n\\r]+\"."
:prefix t
;; `string-trim-left' and `string-trim-right' were moved from subr-x
;; to subr in Emacs 27, so to avoid loading subr-x we use the
;; compatibility function here:
(compat--string-trim-left
(compat--string-trim-right
string
trim-right)
trim-left))
(compat-defun caaar (x)
"Return the `car' of the `car' of the `car' of X."
(declare (pure t))
(car (car (car x))))
(compat-defun caadr (x)
"Return the `car' of the `car' of the `cdr' of X."
(declare (pure t))
(car (car (cdr x))))
(compat-defun cadar (x)
"Return the `car' of the `cdr' of the `car' of X."
(declare (pure t))
(car (cdr (car x))))
(compat-defun caddr (x)
"Return the `car' of the `cdr' of the `cdr' of X."
(declare (pure t))
(car (cdr (cdr x))))
(compat-defun cdaar (x)
"Return the `cdr' of the `car' of the `car' of X."
(declare (pure t))
(cdr (car (car x))))
(compat-defun cdadr (x)
"Return the `cdr' of the `car' of the `cdr' of X."
(declare (pure t))
(cdr (car (cdr x))))
(compat-defun cddar (x)
"Return the `cdr' of the `cdr' of the `car' of X."
(declare (pure t))
(cdr (cdr (car x))))
(compat-defun cdddr (x)
"Return the `cdr' of the `cdr' of the `cdr' of X."
(declare (pure t))
(cdr (cdr (cdr x))))
(compat-defun caaaar (x)
"Return the `car' of the `car' of the `car' of the `car' of X."
(declare (pure t))
(car (car (car (car x)))))
(compat-defun caaadr (x)
"Return the `car' of the `car' of the `car' of the `cdr' of X."
(declare (pure t))
(car (car (car (cdr x)))))
(compat-defun caadar (x)
"Return the `car' of the `car' of the `cdr' of the `car' of X."
(declare (pure t))
(car (car (cdr (car x)))))
(compat-defun caaddr (x)
"Return the `car' of the `car' of the `cdr' of the `cdr' of X."
(declare (pure t))
(car (car (cdr (cdr x)))))
(compat-defun cadaar (x)
"Return the `car' of the `cdr' of the `car' of the `car' of X."
(declare (pure t))
(car (cdr (car (car x)))))
(compat-defun cadadr (x)
"Return the `car' of the `cdr' of the `car' of the `cdr' of X."
(declare (pure t))
(car (cdr (car (cdr x)))))
(compat-defun caddar (x)
"Return the `car' of the `cdr' of the `cdr' of the `car' of X."
(declare (pure t))
(car (cdr (cdr (car x)))))
(compat-defun cadddr (x)
"Return the `car' of the `cdr' of the `cdr' of the `cdr' of X."
(declare (pure t))
(car (cdr (cdr (cdr x)))))
(compat-defun cdaaar (x)
"Return the `cdr' of the `car' of the `car' of the `car' of X."
(declare (pure t))
(cdr (car (car (car x)))))
(compat-defun cdaadr (x)
"Return the `cdr' of the `car' of the `car' of the `cdr' of X."
(declare (pure t))
(cdr (car (car (cdr x)))))
(compat-defun cdadar (x)
"Return the `cdr' of the `car' of the `cdr' of the `car' of X."
(declare (pure t))
(cdr (car (cdr (car x)))))
(compat-defun cdaddr (x)
"Return the `cdr' of the `car' of the `cdr' of the `cdr' of X."
(declare (pure t))
(cdr (car (cdr (cdr x)))))
(compat-defun cddaar (x)
"Return the `cdr' of the `cdr' of the `car' of the `car' of X."
(declare (pure t))
(cdr (cdr (car (car x)))))
(compat-defun cddadr (x)
"Return the `cdr' of the `cdr' of the `car' of the `cdr' of X."
(declare (pure t))
(cdr (cdr (car (cdr x)))))
(compat-defun cdddar (x)
"Return the `cdr' of the `cdr' of the `cdr' of the `car' of X."
(declare (pure t))
(cdr (cdr (cdr (car x)))))
(compat-defun cddddr (x)
"Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X."
(declare (pure t))
(cdr (cdr (cdr (cdr x)))))
(compat-defvar gensym-counter 0
"Number used to construct the name of the next symbol created by `gensym'.")
(compat-defun gensym (&optional prefix)
"Return a new uninterned symbol.
The name is made by appending `gensym-counter' to PREFIX.
PREFIX is a string, and defaults to \"g\"."
(let ((num (prog1 gensym-counter
(setq gensym-counter
(1+ gensym-counter)))))
(make-symbol (format "%s%d" (or prefix "g") num))))
;;;; Defined in files.el
(declare-function temporary-file-directory nil)
;;* UNTESTED
(compat-defun make-nearby-temp-file (prefix &optional dir-flag suffix)
"Create a temporary file as close as possible to `default-directory'.
If PREFIX is a relative file name, and `default-directory' is a
remote file name or located on a mounted file systems, the
temporary file is created in the directory returned by the
function `temporary-file-directory'. Otherwise, the function
`make-temp-file' is used. PREFIX, DIR-FLAG and SUFFIX have the
same meaning as in `make-temp-file'."
(let ((handler (find-file-name-handler
default-directory 'make-nearby-temp-file)))
(if (and handler (not (file-name-absolute-p default-directory)))
(funcall handler 'make-nearby-temp-file prefix dir-flag suffix)
(let ((temporary-file-directory (temporary-file-directory)))
(make-temp-file prefix dir-flag suffix)))))
(compat-defvar mounted-file-systems
(eval-when-compile
(if (memq system-type '(windows-nt cygwin))
"^//[^/]+/"
(concat
"^" (regexp-opt '("/afs/" "/media/" "/mnt" "/net/" "/tmp_mnt/")))))
"File systems that ought to be mounted.")
(compat-defun file-local-name (file)
"Return the local name component of FILE.
This function removes from FILE the specification of the remote host
and the method of accessing the host, leaving only the part that
identifies FILE locally on the remote system.
The returned file name can be used directly as argument of
`process-file', `start-file-process', or `shell-command'."
:realname compat--file-local-name
(or (file-remote-p file 'localname) file))
(compat-defun file-name-quoted-p (name &optional top)
"Whether NAME is quoted with prefix \"/:\".
If NAME is a remote file name and TOP is nil, check the local part of NAME."
:realname compat--file-name-quoted-p
(let ((file-name-handler-alist (unless top file-name-handler-alist)))
(string-prefix-p "/:" (compat--file-local-name name))))
(compat-defun file-name-quote (name &optional top)
"Add the quotation prefix \"/:\" to file NAME.
If NAME is a remote file name and TOP is nil, the local part of
NAME is quoted. If NAME is already a quoted file name, NAME is
returned unchanged."
(let ((file-name-handler-alist (unless top file-name-handler-alist)))
(if (compat--file-name-quoted-p name top)
name
(concat (file-remote-p name) "/:" (compat--file-local-name name)))))
;;* UNTESTED
(compat-defun temporary-file-directory ()
"The directory for writing temporary files.
In case of a remote `default-directory', this is a directory for
temporary files on that remote host. If such a directory does
not exist, or `default-directory' ought to be located on a
mounted file system (see `mounted-file-systems'), the function
returns `default-directory'.
For a non-remote and non-mounted `default-directory', the value of
the variable `temporary-file-directory' is returned."
(let ((handler (find-file-name-handler
default-directory 'temporary-file-directory)))
(if handler
(funcall handler 'temporary-file-directory)
(if (string-match mounted-file-systems default-directory)
default-directory
temporary-file-directory))))
;;* UNTESTED
(compat-defun file-attribute-type (attributes)
"The type field in ATTRIBUTES returned by `file-attributes'.
The value is either t for directory, string (name linked to) for
symbolic link, or nil."
(nth 0 attributes))
;;* UNTESTED
(compat-defun file-attribute-link-number (attributes)
"Return the number of links in ATTRIBUTES returned by `file-attributes'."
(nth 1 attributes))
;;* UNTESTED
(compat-defun file-attribute-user-id (attributes)
"The UID field in ATTRIBUTES returned by `file-attributes'.
This is either a string or a number. If a string value cannot be
looked up, a numeric value, either an integer or a float, is
returned."
(nth 2 attributes))
;;* UNTESTED
(compat-defun file-attribute-group-id (attributes)
"The GID field in ATTRIBUTES returned by `file-attributes'.
This is either a string or a number. If a string value cannot be
looked up, a numeric value, either an integer or a float, is
returned."
(nth 3 attributes))
;;* UNTESTED
(compat-defun file-attribute-access-time (attributes)
"The last access time in ATTRIBUTES returned by `file-attributes'.
This a Lisp timestamp in the style of `current-time'."
(nth 4 attributes))
;;* UNTESTED
(compat-defun file-attribute-modification-time (attributes)
"The modification time in ATTRIBUTES returned by `file-attributes'.
This is the time of the last change to the file's contents, and
is a Lisp timestamp in the style of `current-time'."
(nth 5 attributes))
;;* UNTESTED
(compat-defun file-attribute-status-change-time (attributes)
"The status modification time in ATTRIBUTES returned by `file-attributes'.
This is the time of last change to the file's attributes: owner
and group, access mode bits, etc., and is a Lisp timestamp in the
style of `current-time'."
(nth 6 attributes))
;;* UNTESTED
(compat-defun file-attribute-size (attributes)
"The integer size (in bytes) in ATTRIBUTES returned by `file-attributes'."
(nth 7 attributes))
;;* UNTESTED
(compat-defun file-attribute-modes (attributes)
"The file modes in ATTRIBUTES returned by `file-attributes'.
This is a string of ten letters or dashes as in ls -l."
(nth 8 attributes))
;;* UNTESTED
(compat-defun file-attribute-inode-number (attributes)
"The inode number in ATTRIBUTES returned by `file-attributes'.
It is a nonnegative integer."
(nth 10 attributes))
;;* UNTESTED
(compat-defun file-attribute-device-number (attributes)
"The file system device number in ATTRIBUTES returned by `file-attributes'.
It is an integer."
(nth 11 attributes))
(compat-defun file-attribute-collect (attributes &rest attr-names)
"Return a sublist of ATTRIBUTES returned by `file-attributes'.
ATTR-NAMES are symbols with the selected attribute names.
Valid attribute names are: type, link-number, user-id, group-id,
access-time, modification-time, status-change-time, size, modes,
inode-number and device-number."
(let ((idx '((type . 0)
(link-number . 1)
(user-id . 2)
(group-id . 3)
(access-time . 4)
(modification-time . 5)
(status-change-time . 6)
(size . 7)
(modes . 8)
(inode-number . 10)
(device-number . 11)))
result)
(while attr-names
(let ((attr (pop attr-names)))
(if (assq attr idx)
(push (nth (cdr (assq attr idx))
attributes)
result)
(error "Wrong attribute name '%S'" attr))))
(nreverse result)))
;;;; Defined in subr-x.el
(compat-defmacro if-let* (varlist then &rest else)
"Bind variables according to VARLIST and evaluate THEN or ELSE.
This is like `if-let' but doesn't handle a VARLIST of the form
\(SYMBOL SOMETHING) specially."
:realname compat--if-let*
:feature 'subr-x
(declare (indent 2)
(debug ((&rest [&or symbolp (symbolp form) (form)])
body)))
(let ((empty (make-symbol "s"))
(last t) list)
(dolist (var varlist)
(push `(,(if (cdr var) (car var) empty)
(and ,last ,(or (cadr var) (car var))))
list)
(when (or (cdr var) (consp (car var)))
(setq last (caar list))))
`(let* ,(nreverse list)
(if ,(caar list) ,then ,@else))))
(compat-defmacro when-let* (varlist &rest body)
"Bind variables according to VARLIST and conditionally evaluate BODY.
This is like `when-let' but doesn't handle a VARLIST of the form
\(SYMBOL SOMETHING) specially."
;; :feature 'subr-x
(declare (indent 1) (debug if-let*))
(let ((empty (make-symbol "s"))
(last t) list)
(dolist (var varlist)
(push `(,(if (cdr var) (car var) empty)
(and ,last ,(or (cadr var) (car var))))
list)
(when (or (cdr var) (consp (car var)))
(setq last (caar list))))
`(let* ,(nreverse list)
(when ,(caar list) ,@body))))
(compat-defmacro and-let* (varlist &rest body)
"Bind variables according to VARLIST and conditionally evaluate BODY.
Like `when-let*', except if BODY is empty and all the bindings
are non-nil, then the result is non-nil."
:feature 'subr-x
(declare (indent 1) (debug if-let*))
(let ((empty (make-symbol "s"))
(last t) list)
(dolist (var varlist)
(push `(,(if (cdr var) (car var) empty)
(and ,last ,(or (cadr var) (car var))))
list)
(when (or (cdr var) (consp (car var)))
(setq last (caar list))))
`(let* ,(nreverse list)
(if ,(caar list) ,(macroexp-progn (or body '(t)))))))
;;;; Defined in image.el
;;* UNTESTED
(compat-defun image-property (image property)
"Return the value of PROPERTY in IMAGE.
Properties can be set with
(setf (image-property IMAGE PROPERTY) VALUE)
If VALUE is nil, PROPERTY is removed from IMAGE."
(plist-get (cdr image) property))
;;* UNTESTED
(unless (get 'image-property 'gv-expander)
(gv-define-setter image-property (image property value)
(let ((image* (make-symbol "image"))
(property* (make-symbol "property"))
(value* (make-symbol "value")))
`(let ((,image* ,image)
(,property* ,property)
(,value* ,value))
(if
(null ,value*)
(while
(cdr ,image*)
(if
(eq
(cadr ,image*)
,property*)
(setcdr ,image*
(cdddr ,image*))
(setq ,image*
(cddr ,image*))))
(setcdr ,image*
(plist-put
(cdr ,image*)
,property* ,value*)))))))
(provide 'compat-26)
;;; compat-26.el ends here

642
code/elpa/compat-28.1.1.0/compat-27.el Normal file
View file

@ -0,0 +1,642 @@
;;; compat-27.el --- Compatibility Layer for Emacs 27.1 -*- lexical-binding: t; -*-
;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
;; Author: Philip Kaludercic <philipk@posteo.net>
;; Maintainer: Compat Development <~pkal/compat-devel@lists.sr.ht>
;; URL: https://git.sr.ht/~pkal/compat/
;; Keywords: lisp
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Find here the functionality added in Emacs 27.1, needed by older
;; versions.
;;
;; Do NOT load this library manually. Instead require `compat'.
;;; Code:
(eval-when-compile (require 'compat-macs))
;;;; Defined in fns.c
(compat-defun proper-list-p (object)
"Return OBJECT's length if it is a proper list, nil otherwise.
A proper list is neither circular nor dotted (i.e., its last cdr
is nil)."
:min-version "26.1"
:max-version "26.3"
:realname compat--proper-list-p-length-signal
(condition-case nil
(and (listp object) (length object))
(wrong-type-argument nil)
(circular-list nil)))
(compat-defun proper-list-p (object)
"Return OBJECT's length if it is a proper list, nil otherwise.
A proper list is neither circular nor dotted (i.e., its last cdr
is nil)."
:max-version "25.3"
:realname compat--proper-list-p-tortoise-hare
(when (listp object)
(catch 'cycle
(let ((hare object) (tortoise object)
(max 2) (q 2))
(while (consp hare)
(setq hare (cdr hare))
(when (and (or (/= 0 (setq q (1- q)))
(ignore
(setq max (ash max 1)
q max
tortoise hare)))
(eq hare tortoise))
(throw 'cycle nil)))
(and (null hare) (length object))))))
(compat-defun string-distance (string1 string2 &optional bytecompare)
"Return Levenshtein distance between STRING1 and STRING2.
The distance is the number of deletions, insertions, and substitutions
required to transform STRING1 into STRING2.
If BYTECOMPARE is nil or omitted, compute distance in terms of characters.
If BYTECOMPARE is non-nil, compute distance in terms of bytes.
Letter-case is significant, but text properties are ignored."
;; https://en.wikipedia.org/wiki/Levenshtein_distance
(let ((s1 (if bytecompare
(encode-coding-string string1 'raw-text)
(concat string1 "")))
(s2 (if bytecompare
(encode-coding-string string2 'raw-text)
string2)))
(let* ((len1 (length s1))
(len2 (length s2))
(column (make-vector (1+ len1) 0)))
(dotimes (y len1)
(setf (aref column (1+ y)) y))
(dotimes (x len2)
(setf (aref column 0) (1+ x))
(let ((lastdiag x) olddiag)
(dotimes (y len1)
(setf olddiag (aref column (1+ y))
(aref column (1+ y))
(min (+ (if (= (aref s1 y) (aref s2 x)) 0 1)
lastdiag)
(1+ (aref column (1+ y)))
(1+ (aref column y)))
lastdiag olddiag))))
(aref column len1))))
;;;; Defined in window.c
(compat-defun recenter (&optional arg redisplay)
"Handle optional argument REDISPLAY."
:prefix t
(recenter arg)
(when (and redisplay recenter-redisplay)
(redisplay)))
;;;; Defined in keymap.c
(compat-defun lookup-key (keymap key &optional accept-default)
"Allow for KEYMAP to be a list of keymaps."
:prefix t
(cond
((keymapp keymap)
(lookup-key keymap key accept-default))
((listp keymap)
(catch 'found
(dolist (map keymap)
(let ((fn (lookup-key map key accept-default)))
(when fn (throw 'found fn))))))
((signal 'wrong-type-argument (list 'keymapp keymap)))))
;;;; Defined in json.c
(declare-function json-parse-string nil (string &rest args))
(declare-function json-encode-string "json" (object))
(declare-function json-read-from-string "json" (string))
(declare-function json-read "json" ())
(defvar json-object-type)
(defvar json-array-type)
(defvar json-false)
(defvar json-null)
(compat-defun json-serialize (object &rest args)
"Return the JSON representation of OBJECT as a string.
OBJECT must be t, a number, string, vector, hashtable, alist, plist,
or the Lisp equivalents to the JSON null and false values, and its
elements must recursively consist of the same kinds of values. t will
be converted to the JSON true value. Vectors will be converted to
JSON arrays, whereas hashtables, alists and plists are converted to
JSON objects. Hashtable keys must be strings without embedded null
characters and must be unique within each object. Alist and plist
keys must be symbols; if a key is duplicate, the first instance is
used.
The Lisp equivalents to the JSON null and false values are
configurable in the arguments ARGS, a list of keyword/argument pairs:
The keyword argument `:null-object' specifies which object to use
to represent a JSON null value. It defaults to `:null'.
The keyword argument `:false-object' specifies which object to use to
represent a JSON false value. It defaults to `:false'.
In you specify the same value for `:null-object' and `:false-object',
a potentially ambiguous situation, the JSON output will not contain
any JSON false values."
:cond (condition-case nil
(let ((inhibit-message t))
(equal (json-parse-string "[]") nil))
(json-unavailable t)
(void-function t))
:realname compat--json-serialize
(require 'json)
(let ((json-false (or (plist-get args :false-object) :false))
(json-null (or (plist-get args :null-object) :null)))
(json-encode-string object)))
(compat-defun json-insert (object &rest args)
"Insert the JSON representation of OBJECT before point.
This is the same as (insert (json-serialize OBJECT)), but potentially
faster. See the function `json-serialize' for allowed values of
OBJECT."
:cond (condition-case nil
(let ((inhibit-message t))
(equal (json-parse-string "[]") nil))
(json-unavailable t)
(void-function t))
(insert (apply #'compat--json-serialize object args)))
(compat-defun json-parse-string (string &rest args)
"Parse the JSON STRING into a Lisp object.
This is essentially the reverse operation of `json-serialize', which
see. The returned object will be the JSON null value, the JSON false
value, t, a number, a string, a vector, a list, a hashtable, an alist,
or a plist. Its elements will be further objects of these types. If
there are duplicate keys in an object, all but the last one are
ignored. If STRING doesn't contain a valid JSON object, this function
signals an error of type `json-parse-error'.
The arguments ARGS are a list of keyword/argument pairs:
The keyword argument `:object-type' specifies which Lisp type is used
to represent objects; it can be `hash-table', `alist' or `plist'. It
defaults to `hash-table'.
The keyword argument `:array-type' specifies which Lisp type is used
to represent arrays; it can be `array' (the default) or `list'.
The keyword argument `:null-object' specifies which object to use
to represent a JSON null value. It defaults to `:null'.
The keyword argument `:false-object' specifies which object to use to
represent a JSON false value. It defaults to `:false'."
:cond (condition-case nil
(let ((inhibit-message t))
(equal (json-parse-string "[]") nil))
(json-unavailable t)
(void-function t))
(require 'json)
(condition-case err
(let ((json-object-type (or (plist-get args :object-type) 'hash-table))
(json-array-type (or (plist-get args :array-type) 'vector))
(json-false (or (plist-get args :false-object) :false))
(json-null (or (plist-get args :null-object) :null)))
(when (eq json-array-type 'array)
(setq json-array-type 'vector))
(json-read-from-string string))
(json-error (signal 'json-parse-error err))))
(compat-defun json-parse-buffer (&rest args)
"Read JSON object from current buffer starting at point.
Move point after the end of the object if parsing was successful.
On error, don't move point.
The returned object will be a vector, list, hashtable, alist, or
plist. Its elements will be the JSON null value, the JSON false
value, t, numbers, strings, or further vectors, lists, hashtables,
alists, or plists. If there are duplicate keys in an object, all
but the last one are ignored.
If the current buffer doesn't contain a valid JSON object, the
function signals an error of type `json-parse-error'.
The arguments ARGS are a list of keyword/argument pairs:
The keyword argument `:object-type' specifies which Lisp type is used
to represent objects; it can be `hash-table', `alist' or `plist'. It
defaults to `hash-table'.
The keyword argument `:array-type' specifies which Lisp type is used
to represent arrays; it can be `array' (the default) or `list'.
The keyword argument `:null-object' specifies which object to use
to represent a JSON null value. It defaults to `:null'.
The keyword argument `:false-object' specifies which object to use to
represent a JSON false value. It defaults to `:false'."
:cond (condition-case nil
(let ((inhibit-message t))
(equal (json-parse-string "[]") nil))
(json-unavailable t)
(void-function t))
(require 'json)
(condition-case err
(let ((json-object-type (or (plist-get args :object-type) 'hash-table))
(json-array-type (or (plist-get args :array-type) 'vector))
(json-false (or (plist-get args :false-object) :false))
(json-null (or (plist-get args :null-object) :null)))
(when (eq json-array-type 'array)
(setq json-array-type 'vector))
(json-read))
(json-error (signal 'json-parse-buffer err))))
;;;; Defined in timefns.c
(compat-defun time-equal-p (t1 t2)
"Return non-nil if time value T1 is equal to time value T2.
A nil value for either argument stands for the current time."
:note "This function is not as accurate as the actual `time-equal-p'."
(cond
((eq t1 t2))
((and (consp t1) (consp t2))
(equal t1 t2))
((let ((now (current-time)))
;; Due to inaccuracies and the relatively slow evaluating of
;; Emacs Lisp compared to C, we allow for slight inaccuracies
;; (less than a millisecond) when comparing time values.
(< (abs (- (float-time (or t1 now))
(float-time (or t2 now))))
1e-5)))))
;;;; Defined in subr.el
(compat-defmacro setq-local (&rest pairs)
"Handle multiple assignments."
:prefix t
(unless (zerop (mod (length pairs) 2))
(error "PAIRS must have an even number of variable/value members"))
(let (body)
(while pairs
(let* ((sym (pop pairs))
(val (pop pairs)))
(unless (symbolp sym)
(error "Attempting to set a non-symbol: %s" (car pairs)))
(push `(set (make-local-variable ,sym) ,val)
body)))
(cons 'progn (nreverse body))))
;;* UNTESTED
(compat-defmacro ignore-error (condition &rest body)
"Execute BODY; if the error CONDITION occurs, return nil.
Otherwise, return result of last form in BODY.
CONDITION can also be a list of error conditions."
(declare (debug t) (indent 1))
`(condition-case nil (progn ,@body) (,condition nil)))
;;* UNTESTED
(compat-defmacro dolist-with-progress-reporter (spec reporter-or-message &rest body)
"Loop over a list and report progress in the echo area.
Evaluate BODY with VAR bound to each car from LIST, in turn.
Then evaluate RESULT to get return value, default nil.
REPORTER-OR-MESSAGE is a progress reporter object or a string. In the latter
case, use this string to create a progress reporter.
At each iteration, print the reporter message followed by progress
percentage in the echo area. After the loop is finished,
print the reporter message followed by the word \"done\".
\(fn (VAR LIST [RESULT]) REPORTER-OR-MESSAGE BODY...)"
(declare (indent 2) (debug ((symbolp form &optional form) form body)))
(let ((prep (make-symbol "--dolist-progress-reporter--"))
(count (make-symbol "--dolist-count--"))
(list (make-symbol "--dolist-list--")))
`(let ((,prep ,reporter-or-message)
(,count 0)
(,list ,(cadr spec)))
(when (stringp ,prep)
(setq ,prep (make-progress-reporter ,prep 0 (1- (length ,list)))))
(dolist (,(car spec) ,list)
,@body
(progress-reporter-update ,prep (setq ,count (1+ ,count))))
(progress-reporter-done ,prep)
(or ,@(cdr (cdr spec)) nil))))
(compat-defun flatten-tree (tree)
"Return a \"flattened\" copy of TREE.
In other words, return a list of the non-nil terminal nodes, or
leaves, of the tree of cons cells rooted at TREE. Leaves in the
returned list are in the same order as in TREE.
\(flatten-tree \\='(1 (2 . 3) nil (4 5 (6)) 7))
=> (1 2 3 4 5 6 7)"
(let (elems)
(while (consp tree)
(let ((elem (pop tree)))
(while (consp elem)
(push (cdr elem) tree)
(setq elem (car elem)))
(if elem (push elem elems))))
(if tree (push tree elems))
(nreverse elems)))
(compat-defun xor (cond1 cond2)
"Return the boolean exclusive-or of COND1 and COND2.
If only one of the arguments is non-nil, return it; otherwise
return nil."
(declare (pure t) (side-effect-free error-free))
(cond ((not cond1) cond2)
((not cond2) cond1)))
(compat-defvar regexp-unmatchable "\\`a\\`"
"Standard regexp guaranteed not to match any string at all."
:constant t)
(compat-defun assoc-delete-all (key alist &optional test)
"Delete from ALIST all elements whose car is KEY.
Compare keys with TEST. Defaults to `equal'.
Return the modified alist.
Elements of ALIST that are not conses are ignored."
:prefix t
(unless test (setq test #'equal))
(while (and (consp (car alist))
(funcall test (caar alist) key))
(setq alist (cdr alist)))
(let ((tail alist) tail-cdr)
(while (setq tail-cdr (cdr tail))
(if (and (consp (car tail-cdr))
(funcall test (caar tail-cdr) key))
(setcdr tail (cdr tail-cdr))
(setq tail tail-cdr))))
alist)
;;;; Defined in simple.el
;;* UNTESTED
(compat-defun decoded-time-second (time)
"The seconds in TIME, which is a value returned by `decode-time'.
This is an integer between 0 and 60 (inclusive). (60 is a leap
second, which only some operating systems support.)"
(nth 0 time))
;;* UNTESTED
(compat-defun decoded-time-minute (time)
"The minutes in TIME, which is a value returned by `decode-time'.
This is an integer between 0 and 59 (inclusive)."
(nth 1 time))
;;* UNTESTED
(compat-defun decoded-time-hour (time)
"The hours in TIME, which is a value returned by `decode-time'.
This is an integer between 0 and 23 (inclusive)."
(nth 2 time))
;;* UNTESTED
(compat-defun decoded-time-day (time)
"The day-of-the-month in TIME, which is a value returned by `decode-time'.
This is an integer between 1 and 31 (inclusive)."
(nth 3 time))
;;* UNTESTED
(compat-defun decoded-time-month (time)
"The month in TIME, which is a value returned by `decode-time'.
This is an integer between 1 and 12 (inclusive). January is 1."
(nth 4 time))
;;* UNTESTED
(compat-defun decoded-time-year (time)
"The year in TIME, which is a value returned by `decode-time'.
This is a four digit integer."
(nth 5 time))
;;* UNTESTED
(compat-defun decoded-time-weekday (time)
"The day-of-the-week in TIME, which is a value returned by `decode-time'.
This is a number between 0 and 6, and 0 is Sunday."
(nth 6 time))
;;* UNTESTED
(compat-defun decoded-time-dst (time)
"The daylight saving time in TIME, which is a value returned by `decode-time'.
This is t if daylight saving time is in effect, and nil if not."
(nth 7 time))
;;* UNTESTED
(compat-defun decoded-time-zone (time)
"The time zone in TIME, which is a value returned by `decode-time'.
This is an integer indicating the UTC offset in seconds, i.e.,
the number of seconds east of Greenwich."
(nth 8 time))
;; TODO define gv-setters
;;;; Defined in files.el
(compat-defun file-size-human-readable (file-size &optional flavor space unit)
"Handle the optional third and forth argument:
Optional third argument SPACE is a string put between the number and unit.
It defaults to the empty string. We recommend a single space or
non-breaking space, unless other constraints prohibit a space in that
position.
Optional fourth argument UNIT is the unit to use. It defaults to \"B\"
when FLAVOR is `iec' and the empty string otherwise. We recommend \"B\"
in all cases, since that is the standard symbol for byte."
:prefix t
(let ((power (if (or (null flavor) (eq flavor 'iec))
1024.0
1000.0))
(prefixes '("" "k" "M" "G" "T" "P" "E" "Z" "Y")))
(while (and (>= file-size power) (cdr prefixes))
(setq file-size (/ file-size power)
prefixes (cdr prefixes)))
(let* ((prefix (car prefixes))
(prefixed-unit (if (eq flavor 'iec)
(concat
(if (string= prefix "k") "K" prefix)
(if (string= prefix "") "" "i")
(or unit "B"))
(concat prefix unit))))
(format (if (and (>= (mod file-size 1.0) 0.05)
(< (mod file-size 1.0) 0.95))
"%.1f%s%s"
"%.0f%s%s")
file-size
(if (string= prefixed-unit "") "" (or space ""))
prefixed-unit))))
(declare-function compat--file-name-quote "compat-26"
(name &optional top))
;;*UNTESTED
(compat-defun exec-path ()
"Return list of directories to search programs to run in remote subprocesses.
The remote host is identified by `default-directory'. For remote
hosts that do not support subprocesses, this returns nil.
If `default-directory' is a local directory, this function returns
the value of the variable `exec-path'."
:realname compat--exec-path
(cond
((let ((handler (find-file-name-handler default-directory 'exec-path)))
;; FIXME: The handler was added in 27.1, and this compatibility
;; function only applies to versions of Emacs before that.
(when handler
(condition-case nil
(funcall handler 'exec-path)
(error nil)))))
((file-remote-p default-directory)
;; TODO: This is not completely portable, even if "sh" and
;; "getconf" should be provided on every POSIX system, the chance
;; of this not working are greater than zero.
;;
;; FIXME: This invokes a shell process every time exec-path is
;; called. It should instead be cached on a host-local basis.
(with-temp-buffer
(if (condition-case nil
(zerop (process-file "sh" nil t nil "-c" "getconf PATH"))
(file-missing t))
(list "/bin" "/usr/bin")
(let (path)
(while (re-search-forward "\\([^:]+?\\)[\n:]" nil t)
(push (match-string 1) path))
(nreverse path)))))
(exec-path)))
(declare-function compat--file-local-name "compat-26"
(file))
;;*UNTESTED
(compat-defun executable-find (command &optional remote)
"Search for COMMAND in `exec-path' and return the absolute file name.
Return nil if COMMAND is not found anywhere in `exec-path'. If
REMOTE is non-nil, search on the remote host indicated by
`default-directory' instead."
:prefix t
(if (and remote (file-remote-p default-directory))
(let ((res (locate-file
command
(mapcar
(apply-partially
#'concat (file-remote-p default-directory))
(compat--exec-path))
exec-suffixes 'file-executable-p)))
(when (stringp res) (compat--file-local-name res)))
(executable-find command)))
;; TODO provide advice for directory-files-recursively
;;;; Defined in format-spec.el
;; TODO provide advice for format-spec
;;;; Defined in regexp-opt.el
(compat-defun regexp-opt (strings &optional paren)
"Handle an empty list of strings."
:prefix t
(if (null strings)
(let ((re "\\`a\\`"))
(cond ((null paren)
(concat "\\(?:" re "\\)"))
((stringp paren)
(concat paren re "\\)"))
((eq paren 'words)
(concat "\\<\\(" re "\\)\\>"))
((eq paren 'symbols)
(concat "\\_\\(<" re "\\)\\_>"))
((concat "\\(" re "\\)"))))
(regexp-opt strings paren)))
;;;; Defined in package.el
(declare-function lm-header "lisp-mnt")
;;* UNTESTED
(compat-defun package-get-version ()
"Return the version number of the package in which this is used.
Assumes it is used from an Elisp file placed inside the top-level directory
of an installed ELPA package.
The return value is a string (or nil in case we can’t find it)."
;; In a sense, this is a lie, but it does just what we want: precompute
;; the version at compile time and hardcodes it into the .elc file!
(declare (pure t))
;; Hack alert!
(let ((file
(or (and (boundp 'byte-compile-current-file) byte-compile-current-file)
load-file-name
buffer-file-name)))
(cond
((null file) nil)
;; Packages are normally installed into directories named "<pkg>-<vers>",
;; so get the version number from there.
((string-match
"/[^/]+-\\([0-9]\\(?:[0-9.]\\|pre\\|beta\\|alpha\\|snapshot\\)+\\)/[^/]+\\'"
file)
(match-string 1 file))
;; For packages run straight from the an elpa.git clone, there's no
;; "-<vers>" in the directory name, so we have to fetch the version
;; the hard way.
((let* ((pkgdir (file-name-directory file))
(pkgname (file-name-nondirectory (directory-file-name pkgdir)))
(mainfile (expand-file-name (concat pkgname ".el") pkgdir)))
(when (file-readable-p mainfile)
(require 'lisp-mnt)
(with-temp-buffer
(insert-file-contents mainfile)
(or (lm-header "package-version")
(lm-header "version")))))))))
;;;; Defined in dired.el
(declare-function
dired-get-marked-files "dired.el"
(&optional localp arg filter distinguish-one-marked error))
;;* UNTESTED
(compat-defun dired-get-marked-files
(&optional localp arg filter distinguish-one-marked error)
"Return the marked files’ names as list of strings."
:feature 'dired
:prefix t
(let ((result (dired-get-marked-files localp arg filter distinguish-one-marked)))
(if (and (null result) error)
(user-error (if (stringp error) error "No files specified"))
result)))
;;;; Defined in time-date.el
(compat-defun date-days-in-month (year month)
"The number of days in MONTH in YEAR."
:feature 'time-date
(unless (and (numberp month)
(<= 1 month)
(<= month 12))
(error "Month %s is invalid" month))
(if (= month 2)
(if (date-leap-year-p year)
29
28)
(if (memq month '(1 3 5 7 8 10 12))
31
30)))
(provide 'compat-27)
;;; compat-27.el ends here

835
code/elpa/compat-28.1.1.0/compat-28.el Normal file
View file

@ -0,0 +1,835 @@
;;; compat-28.el --- Compatibility Layer for Emacs 28.1 -*- lexical-binding: t; -*-
;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
;; Author: Philip Kaludercic <philipk@posteo.net>
;; Maintainer: Compat Development <~pkal/compat-devel@lists.sr.ht>
;; URL: https://git.sr.ht/~pkal/compat/
;; Keywords: lisp
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Find here the functionality added in Emacs 28.1, needed by older
;; versions.
;;
;; Do NOT load this library manually. Instead require `compat'.
;;; Code:
(eval-when-compile (require 'compat-macs))
;;;; Defined in fns.c
;;* INCOMPLETE FEATURE: Should handle multibyte regular expressions
(compat-defun string-search (needle haystack &optional start-pos)
"Search for the string NEEDLE in the strign HAYSTACK.
The return value is the position of the first occurrence of
NEEDLE in HAYSTACK, or nil if no match was found.
The optional START-POS argument says where to start searching in
HAYSTACK and defaults to zero (start at the beginning).
It must be between zero and the length of HAYSTACK, inclusive.
Case is always significant and text properties are ignored."
:note "Prior to Emacs 27 `string-match' has issues handling
multibyte regular expressions. As the compatibility function
for `string-search' is implemented via `string-match', these
issues are inherited."
(when (and start-pos (or (< (length haystack) start-pos)
(< start-pos 0)))
(signal 'args-out-of-range (list start-pos)))
(save-match-data
(let ((case-fold-search nil))
(string-match (regexp-quote needle) haystack start-pos))))
(compat-defun length= (sequence length)
"Returns non-nil if SEQUENCE has a length equal to LENGTH."
(cond
((null sequence) (zerop length))
((consp sequence)
(and (null (nthcdr length sequence))
(nthcdr (1- length) sequence)
t))
((arrayp sequence)
(= (length sequence) length))
((signal 'wrong-type-argument sequence))))
(compat-defun length< (sequence length)
"Returns non-nil if SEQUENCE is shorter than LENGTH."
(cond
((null sequence) (not (zerop length)))
((listp sequence)
(null (nthcdr (1- length) sequence)))
((arrayp sequence)
(< (length sequence) length))
((signal 'wrong-type-argument sequence))))
(compat-defun length> (sequence length)
"Returns non-nil if SEQUENCE is longer than LENGTH."
(cond
((listp sequence)
(and (nthcdr length sequence) t))
((arrayp sequence)
(> (length sequence) length))
((signal 'wrong-type-argument sequence))))
;;;; Defined in fileio.c
(compat-defun file-name-concat (directory &rest components)
"Append COMPONENTS to DIRECTORY and return the resulting string.
Elements in COMPONENTS must be a string or nil.
DIRECTORY or the non-final elements in COMPONENTS may or may not end
with a slash -- if they don’t end with a slash, a slash will be
inserted before contatenating."
(let ((seperator (eval-when-compile
(if (memq system-type '(ms-dos windows-nt cygwin))
"\\" "/")))
(last (if components (car (last components)) directory)))
(mapconcat (lambda (part)
(if (eq part last) ;the last component is not modified
last
(replace-regexp-in-string
(concat seperator "+\\'") "" part)))
(cons directory components)
seperator)))
;;;; Defined in alloc.c
;;* UNTESTED (but also not necessary)
(compat-defun garbage-collect-maybe (_factor)
"Call ‘garbage-collect’ if enough allocation happened.
FACTOR determines what \"enough\" means here: If FACTOR is a
positive number N, it means to run GC if more than 1/Nth of the
allocations needed to trigger automatic allocation took place.
Therefore, as N gets higher, this is more likely to perform a GC.
Returns non-nil if GC happened, and nil otherwise."
:note "For releases of Emacs before version 28, this function will do nothing."
;; Do nothing
nil)
;;;; Defined in filelock.c
(compat-defun unlock-buffer ()
"Handle `file-error' conditions:
Handles file system errors by calling ‘display-warning’ and
continuing as if the error did not occur."
:prefix t
(condition-case error
(unlock-buffer)
(file-error
(display-warning
'(unlock-file)
(message "%s, ignored" (error-message-string error))
:warning))))
;;;; Defined in characters.c
(compat-defun string-width (string &optional from to)
"Handle optional arguments FROM and TO:
Optional arguments FROM and TO specify the substring of STRING to
consider, and are interpreted as in `substring'."
:prefix t
(string-width (substring string (or from 0) to)))
;;;; Defined in dired.c
;;* UNTESTED
(compat-defun directory-files (directory &optional full match nosort count)
"Handle additional optional argument COUNT:
If COUNT is non-nil and a natural number, the function will
return COUNT number of file names (if so many are present)."
:prefix t
(let ((files (directory-files directory full match nosort)))
(when (natnump count)
(setf (nthcdr count files) nil))
files))
;;;; Defined in json.c
(declare-function json-insert nil (object &rest args))
(declare-function json-serialize nil (object &rest args))
(declare-function json-parse-string nil (string &rest args))
(declare-function json-parse-buffer nil (&rest args))
(compat-defun json-serialize (object &rest args)
"Handle top-level JSON values."
:prefix t
:min-version "27"
(if (or (listp object) (vectorp object))
(apply #'json-serialize object args)
(substring (json-serialize (list object)) 1 -1)))
(compat-defun json-insert (object &rest args)
"Handle top-level JSON values."
:prefix t
:min-version "27"
(if (or (listp object) (vectorp object))
(apply #'json-insert object args)
(insert (apply #'compat-json-serialize object args))))
(compat-defun json-parse-string (string &rest args)
"Handle top-level JSON values."
:prefix t
:min-version "27"
(if (string-match-p "\\`[[:space:]]*[[{]" string)
(apply #'json-parse-string string args)
;; Wrap the string in an array, and extract the value back using
;; `elt', to ensure that no matter what the value of `:array-type'
;; is we can access the first element.
(elt (apply #'json-parse-string (concat "[" string "]") args) 0)))
(compat-defun json-parse-buffer (&rest args)
"Handle top-level JSON values."
:prefix t
:min-version "27"
(if (looking-at-p "[[:space:]]*[[{]")
(apply #'json-parse-buffer args)
(catch 'escape
(atomic-change-group
(with-syntax-table
(let ((st (make-syntax-table)))
(modify-syntax-entry ?\" "\"" st)
(modify-syntax-entry ?. "_" st)
st)
(let ((inhibit-read-only t))
(save-excursion
(insert "[")
(forward-sexp 1)
(insert "]"))))
(throw 'escape (elt (apply #'json-parse-buffer args) 0))))))
;;;; xfaces.c
(compat-defun color-values-from-color-spec (spec)
"Parse color SPEC as a numeric color and return (RED GREEN BLUE).
This function recognises the following formats for SPEC:
#RGB, where R, G and B are hex numbers of equal length, 1-4 digits each.
rgb:R/G/B, where R, G, and B are hex numbers, 1-4 digits each.
rgbi:R/G/B, where R, G and B are floating-point numbers in [0,1].
If SPEC is not in one of the above forms, return nil.
Each of the 3 integer members of the resulting list, RED, GREEN,
and BLUE, is normalized to have its value in [0,65535]."
(let ((case-fold-search nil))
(save-match-data
(cond
((string-match
;; (rx bos "#"
;; (or (: (group-n 1 (= 1 hex)) (group-n 2 (= 1 hex)) (group-n 3 (= 1 hex)))
;; (: (group-n 1 (= 2 hex)) (group-n 2 (= 2 hex)) (group-n 3 (= 2 hex)))
;; (: (group-n 1 (= 3 hex)) (group-n 2 (= 3 hex)) (group-n 3 (= 3 hex)))
;; (: (group-n 1 (= 4 hex)) (group-n 2 (= 4 hex)) (group-n 3 (= 4 hex))))
;; eos)
"\\`#\\(?:\\(?1:[[:xdigit:]]\\{1\\}\\)\\(?2:[[:xdigit:]]\\{1\\}\\)\\(?3:[[:xdigit:]]\\{1\\}\\)\\|\\(?1:[[:xdigit:]]\\{2\\}\\)\\(?2:[[:xdigit:]]\\{2\\}\\)\\(?3:[[:xdigit:]]\\{2\\}\\)\\|\\(?1:[[:xdigit:]]\\{3\\}\\)\\(?2:[[:xdigit:]]\\{3\\}\\)\\(?3:[[:xdigit:]]\\{3\\}\\)\\|\\(?1:[[:xdigit:]]\\{4\\}\\)\\(?2:[[:xdigit:]]\\{4\\}\\)\\(?3:[[:xdigit:]]\\{4\\}\\)\\)\\'"
spec)
(let ((max (1- (ash 1 (* (- (match-end 1) (match-beginning 1)) 4)))))
(list (/ (* (string-to-number (match-string 1 spec) 16) 65535) max)
(/ (* (string-to-number (match-string 2 spec) 16) 65535) max)
(/ (* (string-to-number (match-string 3 spec) 16) 65535) max))))
((string-match
;; (rx bos "rgb:"
;; (group (** 1 4 hex)) "/"
;; (group (** 1 4 hex)) "/"
;; (group (** 1 4 hex))
;; eos)
"\\`rgb:\\([[:xdigit:]]\\{1,4\\}\\)/\\([[:xdigit:]]\\{1,4\\}\\)/\\([[:xdigit:]]\\{1,4\\}\\)\\'"
spec)
(list (/ (* (string-to-number (match-string 1 spec) 16) 65535)
(1- (ash 1 (* (- (match-end 1) (match-beginning 1)) 4))))
(/ (* (string-to-number (match-string 2 spec) 16) 65535)
(1- (ash 1 (* (- (match-end 2) (match-beginning 2)) 4))))
(/ (* (string-to-number (match-string 3 spec) 16) 65535)
(1- (ash 1 (* (- (match-end 3) (match-beginning 3)) 4))))))
;; The "RGBi" (RGB Intensity) specification is defined by
;; XCMS[0], see [1] for the implementation in Xlib.
;;
;; [0] http://www.nic.funet.fi/pub/X11/X11R4/DOCS/color/Xcms.text
;; [1] https://gitlab.freedesktop.org/xorg/lib/libx11/-/blob/master/src/xcms/LRGB.c#L1392
((string-match
(rx bos "rgbi:" (* space)
(group (? (or "-" "+"))
(or (: (+ digit) (? "." (* digit)))
(: "." (+ digit)))
(? "e" (? (or "-" "+")) (+ digit)))
"/" (* space)
(group (? (or "-" "+"))
(or (: (+ digit) (? "." (* digit)))
(: "." (+ digit)))
(? "e" (? (or "-" "+")) (+ digit)))
"/" (* space)
(group (? (or "-" "+"))
(or (: (+ digit) (? "." (* digit)))
(: "." (+ digit)))
(? "e" (? (or "-" "+")) (+ digit)))
eos)
spec)
(let ((r (round (* (string-to-number (match-string 1 spec)) 65535)))
(g (round (* (string-to-number (match-string 2 spec)) 65535)))
(b (round (* (string-to-number (match-string 3 spec)) 65535))))
(when (and (<= 0 r) (<= r 65535)
(<= 0 g) (<= g 65535)
(<= 0 b) (<= b 65535))
(list r g b))))))))
;;;; Defined in subr.el
;;* INCOMPLETE FEATURE: Should handle multibyte regular expressions
(compat-defun string-replace (fromstring tostring instring)
"Replace FROMSTRING with TOSTRING in INSTRING each time it occurs."
(when (equal fromstring "")
(signal 'wrong-length-argument '(0)))
(let ((case-fold-search nil))
(replace-regexp-in-string
(regexp-quote fromstring)
tostring instring
t t)))
(compat-defun always (&rest _arguments)
"Do nothing and return t.
This function accepts any number of ARGUMENTS, but ignores them.
Also see `ignore'."
t)
;;* UNTESTED
(compat-defun insert-into-buffer (buffer &optional start end)
"Insert the contents of the current buffer into BUFFER.
If START/END, only insert that region from the current buffer.
Point in BUFFER will be placed after the inserted text."
(let ((current (current-buffer)))
(with-current-buffer buffer
(insert-buffer-substring current start end))))
;;* UNTESTED
(compat-defun replace-string-in-region (string replacement &optional start end)
"Replace STRING with REPLACEMENT in the region from START to END.
The number of replaced occurrences are returned, or nil if STRING
doesn't exist in the region.
If START is nil, use the current point. If END is nil, use `point-max'.
Comparisons and replacements are done with fixed case."
(if start
(when (< start (point-min))
(error "Start before start of buffer"))
(setq start (point)))
(if end
(when (> end (point-max))
(error "End after end of buffer"))
(setq end (point-max)))
(save-excursion
(let ((matches 0)
(case-fold-search nil))
(goto-char start)
(while (search-forward string end t)
(delete-region (match-beginning 0) (match-end 0))
(insert replacement)
(setq matches (1+ matches)))
(and (not (zerop matches))
matches))))
;;* UNTESTED
(compat-defun replace-regexp-in-region (regexp replacement &optional start end)
"Replace REGEXP with REPLACEMENT in the region from START to END.
The number of replaced occurrences are returned, or nil if REGEXP
doesn't exist in the region.
If START is nil, use the current point. If END is nil, use `point-max'.
Comparisons and replacements are done with fixed case.
REPLACEMENT can use the following special elements:
`\\&' in NEWTEXT means substitute original matched text.
`\\N' means substitute what matched the Nth `\\(...\\)'.
If Nth parens didn't match, substitute nothing.
`\\\\' means insert one `\\'.
`\\?' is treated literally."
(if start
(when (< start (point-min))
(error "Start before start of buffer"))
(setq start (point)))
(if end
(when (> end (point-max))
(error "End after end of buffer"))
(setq end (point-max)))
(save-excursion
(let ((matches 0)
(case-fold-search nil))
(goto-char start)
(while (re-search-forward regexp end t)
(replace-match replacement t)
(setq matches (1+ matches)))
(and (not (zerop matches))
matches))))
;;* UNTESTED
(compat-defun buffer-local-boundp (symbol buffer)
"Return non-nil if SYMBOL is bound in BUFFER.
Also see `local-variable-p'."
(catch 'fail
(condition-case nil
(buffer-local-value symbol buffer)
(void-variable nil (throw 'fail nil)))
t))
;;* UNTESTED
(compat-defmacro with-existing-directory (&rest body)
"Execute BODY with `default-directory' bound to an existing directory.
If `default-directory' is already an existing directory, it's not changed."
(declare (indent 0) (debug t))
(let ((quit (make-symbol "with-existing-directory-quit")))
`(catch ',quit
(dolist (dir (list default-directory
(expand-file-name "~/")
(getenv "TMPDIR")
"/tmp/"
;; XXX: check if "/" works on non-POSIX
;; system.
"/"))
(when (and dir (file-exists-p dir))
(throw ',quit (let ((default-directory dir))
,@body)))))))
;;* UNTESTED
(compat-defmacro dlet (binders &rest body)
"Like `let' but using dynamic scoping."
(declare (indent 1) (debug let))
`(let (_)
,@(mapcar (lambda (binder)
`(defvar ,(if (consp binder) (car binder) binder)))
binders)
(let ,binders ,@body)))
(compat-defun ensure-list (object)
"Return OBJECT as a list.
If OBJECT is already a list, return OBJECT itself. If it's
not a list, return a one-element list containing OBJECT."
(if (listp object)
object
(list object)))
;;;; Defined in subr-x.el
(compat-defun string-clean-whitespace (string)
"Clean up whitespace in STRING.
All sequences of whitespaces in STRING are collapsed into a
single space character, and leading/trailing whitespace is
removed."
:feature 'subr-x
(let ((blank "[[:blank:]\r\n]+"))
(replace-regexp-in-string
"^[[:blank:]\r\n]+\\|[[:blank:]\r\n]+$"
""
(replace-regexp-in-string
blank " " string))))
(compat-defun string-fill (string length)
"Clean up whitespace in STRING.
All sequences of whitespaces in STRING are collapsed into a
single space character, and leading/trailing whitespace is
removed."
:feature 'subr-x
(with-temp-buffer
(insert string)
(goto-char (point-min))
(let ((fill-column length)
(adaptive-fill-mode nil))
(fill-region (point-min) (point-max)))
(buffer-string)))
(compat-defun string-lines (string &optional omit-nulls)
"Split STRING into a list of lines.
If OMIT-NULLS, empty lines will be removed from the results."
:feature 'subr-x
(split-string string "\n" omit-nulls))
(compat-defun string-pad (string length &optional padding start)
"Pad STRING to LENGTH using PADDING.
If PADDING is nil, the space character is used. If not nil, it
should be a character.
If STRING is longer than the absolute value of LENGTH, no padding
is done.
If START is nil (or not present), the padding is done to the end
of the string, and if non-nil, padding is done to the start of
the string."
:feature 'subr-x
(unless (natnump length)
(signal 'wrong-type-argument (list 'natnump length)))
(let ((pad-length (- length (length string))))
(if (< pad-length 0)
string
(concat (and start
(make-string pad-length (or padding ?\s)))
string
(and (not start)
(make-string pad-length (or padding ?\s)))))))
(compat-defun string-chop-newline (string)
"Remove the final newline (if any) from STRING."
:feature 'subr-x
(if (and (>= (length string) 1) (= (aref string (1- (length string))) ?\n))
(substring string 0 -1)
string))
(compat-defmacro named-let (name bindings &rest body)
"Looping construct taken from Scheme.
Like `let', bind variables in BINDINGS and then evaluate BODY,
but with the twist that BODY can evaluate itself recursively by
calling NAME, where the arguments passed to NAME are used
as the new values of the bound variables in the recursive invocation."
:feature 'subr-x
(declare (indent 2) (debug (symbolp (&rest (symbolp form)) body)))
(let ((fargs (mapcar (lambda (b)
(let ((var (if (consp b) (car b) b)))
(make-symbol (symbol-name var))))
bindings))
(aargs (mapcar (lambda (b) (if (consp b) (cadr b))) bindings))
rargs)
(dotimes (i (length bindings))
(let ((b (nth i bindings)))
(push (list (if (consp b) (car b) b) (nth i fargs))
rargs)
(setf (if (consp b) (car b) b)
(nth i fargs))))
(letrec
((quit (make-symbol "quit")) (self (make-symbol "self"))
(total-tco t)
(macro (lambda (&rest args)
(setq total-tco nil)
`(funcall ,self . ,args)))
;; Based on `cl--self-tco':
(tco-progn (lambda (exprs)
(append
(butlast exprs)
(list (funcall tco (car (last exprs)))))))
(tco (lambda (expr)
(cond
((eq (car-safe expr) 'if)
(append (list 'if
(cadr expr)
(funcall tco (nth 2 expr)))
(funcall tco-progn (nthcdr 3 expr))))
((eq (car-safe expr) 'cond)
(let ((conds (cdr expr)) body)
(while conds
(let ((branch (pop conds)))
(push (cond
((cdr branch) ;has tail
(funcall tco-progn branch))
((null conds) ;last element
(list t (funcall tco (car branch))))
((progn
branch)))
body)))
(cons 'cond (nreverse body))))
((eq (car-safe expr) 'or)
(if (cddr expr)
(let ((var (make-symbol "var")))
`(let ((,var ,(cadr expr)))
(if ,var ,(funcall tco var)
,(funcall tco (cons 'or (cddr expr))))))
(funcall tco (cadr expr))))
((eq (car-safe expr) 'condition-case)
(append (list 'condition-case (cadr expr) (nth 2 expr))
(mapcar
(lambda (handler)
(cons (car handler)
(funcall tco-progn (cdr handler))))
(nthcdr 3 expr))))
((memq (car-safe expr) '(and progn))
(cons (car expr) (funcall tco-progn (cdr expr))))
((memq (car-safe expr) '(let let*))
(append (list (car expr) (cadr expr))
(funcall tco-progn (cddr expr))))
((eq (car-safe expr) name)
(let (sets (args (cdr expr)))
(dolist (farg fargs)
(push (list farg (pop args))
sets))
(cons 'setq (apply #'nconc (nreverse sets)))))
(`(throw ',quit ,expr))))))
(let ((tco-body (funcall tco (macroexpand-all (macroexp-progn body)))))
(when tco-body
(setq body `((catch ',quit
(while t (let ,rargs ,@(macroexp-unprogn tco-body))))))))
(let ((expand (macroexpand-all (macroexp-progn body) (list (cons name macro)))))
(if total-tco
`(let ,bindings ,expand)
`(funcall
(letrec ((,self (lambda ,fargs ,expand))) ,self)
,@aargs))))))
;;;; Defined in files.el
(declare-function compat--string-trim-left "compat-26" (string &optional regexp))
(declare-function compat--directory-name-p "compat-25" (name))
(compat-defun file-name-with-extension (filename extension)
"Set the EXTENSION of a FILENAME.
The extension (in a file name) is the part that begins with the last \".\".
Trims a leading dot from the EXTENSION so that either \"foo\" or
\".foo\" can be given.
Errors if the FILENAME or EXTENSION are empty, or if the given
FILENAME has the format of a directory.
See also `file-name-sans-extension'."
(let ((extn (compat--string-trim-left extension "[.]")))
(cond
((string= filename "")
(error "Empty filename"))
((string= extn "")
(error "Malformed extension: %s" extension))
((compat--directory-name-p filename)
(error "Filename is a directory: %s" filename))
(t
(concat (file-name-sans-extension filename) "." extn)))))
;;* UNTESTED
(compat-defun directory-empty-p (dir)
"Return t if DIR names an existing directory containing no other files.
Return nil if DIR does not name a directory, or if there was
trouble determining whether DIR is a directory or empty.
Symbolic links to directories count as directories.
See `file-symlink-p' to distinguish symlinks."
(and (file-directory-p dir)
(null (directory-files dir nil directory-files-no-dot-files-regexp t))))
(compat-defun file-modes-number-to-symbolic (mode &optional filetype)
"Return a string describing a file's MODE.
For instance, if MODE is #o700, then it produces `-rwx------'.
FILETYPE if provided should be a character denoting the type of file,
such as `?d' for a directory, or `?l' for a symbolic link and will override
the leading `-' char."
(string
(or filetype
(pcase (lsh mode -12)
;; POSIX specifies that the file type is included in st_mode
;; and provides names for the file types but values only for
;; the permissions (e.g., S_IWOTH=2).
;; (#o017 ??) ;; #define S_IFMT 00170000
(#o014 ?s) ;; #define S_IFSOCK 0140000
(#o012 ?l) ;; #define S_IFLNK 0120000
;; (8 ??) ;; #define S_IFREG 0100000
(#o006 ?b) ;; #define S_IFBLK 0060000
(#o004 ?d) ;; #define S_IFDIR 0040000
(#o002 ?c) ;; #define S_IFCHR 0020000
(#o001 ?p) ;; #define S_IFIFO 0010000
(_ ?-)))
(if (zerop (logand 256 mode)) ?- ?r)
(if (zerop (logand 128 mode)) ?- ?w)
(if (zerop (logand 64 mode))
(if (zerop (logand 2048 mode)) ?- ?S)
(if (zerop (logand 2048 mode)) ?x ?s))
(if (zerop (logand 32 mode)) ?- ?r)
(if (zerop (logand 16 mode)) ?- ?w)
(if (zerop (logand 8 mode))
(if (zerop (logand 1024 mode)) ?- ?S)
(if (zerop (logand 1024 mode)) ?x ?s))
(if (zerop (logand 4 mode)) ?- ?r)
(if (zerop (logand 2 mode)) ?- ?w)
(if (zerop (logand 512 mode))
(if (zerop (logand 1 mode)) ?- ?x)
(if (zerop (logand 1 mode)) ?T ?t))))
;;* UNTESTED
(compat-defun file-backup-file-names (filename)
"Return a list of backup files for FILENAME.
The list will be sorted by modification time so that the most
recent files are first."
;; `make-backup-file-name' will get us the right directory for
;; ordinary or numeric backups. It might create a directory for
;; backups as a side-effect, according to `backup-directory-alist'.
(let* ((filename (file-name-sans-versions
(make-backup-file-name (expand-file-name filename))))
(dir (file-name-directory filename))
files)
(dolist (file (file-name-all-completions
(file-name-nondirectory filename) dir))
(let ((candidate (concat dir file)))
(when (and (backup-file-name-p candidate)
(string= (file-name-sans-versions candidate) filename))
(push candidate files))))
(sort files #'file-newer-than-file-p)))
(compat-defun make-lock-file-name (filename)
"Make a lock file name for FILENAME.
This prepends \".#\" to the non-directory part of FILENAME, and
doesn't respect `lock-file-name-transforms', as Emacs 28.1 and
onwards does."
(expand-file-name
(concat
".#" (file-name-nondirectory filename))
(file-name-directory filename)))
;;;; Defined in files-x.el
(declare-function tramp-tramp-file-p "tramp" (name))
;;* UNTESTED
(compat-defun null-device ()
"Return the best guess for the null device."
(require 'tramp)
(if (tramp-tramp-file-p default-directory)
"/dev/null"
null-device))
;;;; Defined in minibuffer.el
(compat-defun format-prompt (prompt default &rest format-args)
"Format PROMPT with DEFAULT.
If FORMAT-ARGS is nil, PROMPT is used as a plain string. If
FORMAT-ARGS is non-nil, PROMPT is used as a format control
string, and FORMAT-ARGS are the arguments to be substituted into
it. See `format' for details.
If DEFAULT is a list, the first element is used as the default.
If not, the element is used as is.
If DEFAULT is nil or an empty string, no \"default value\" string
is included in the return value."
(concat
(if (null format-args)
prompt
(apply #'format prompt format-args))
(and default
(or (not (stringp default))
(not (null default)))
(format " (default %s)"
(if (consp default)
(car default)
default)))
": "))
;;;; Defined in windows.el
;;* UNTESTED
(compat-defun count-windows (&optional minibuf all-frames)
"Handle optional argument ALL-FRAMES:
If ALL-FRAMES is non-nil, count the windows in all frames instead
just the selected frame."
:prefix t
(if all-frames
(let ((sum 0))
(dolist (frame (frame-list))
(with-selected-frame frame
(setq sum (+ (count-windows minibuf) sum))))
sum)
(count-windows minibuf)))
;;;; Defined in thingatpt.el
(declare-function mouse-set-point "mouse" (event &optional promote-to-region))
;;* UNTESTED
(compat-defun thing-at-mouse (event thing &optional no-properties)
"Return the THING at mouse click.
Like `thing-at-point', but tries to use the event
where the mouse button is clicked to find a thing nearby."
:feature 'thingatpt
(save-excursion
(mouse-set-point event)
(thing-at-point thing no-properties)))
;;;; Defined in macroexp.el
;;* UNTESTED
(compat-defun macroexp-file-name ()
"Return the name of the file from which the code comes.
Returns nil when we do not know.
A non-nil result is expected to be reliable when called from a macro in order
to find the file in which the macro's call was found, and it should be
reliable as well when used at the top-level of a file.
Other uses risk returning non-nil value that point to the wrong file."
:feature 'macroexp
(let ((file (car (last current-load-list))))
(or (if (stringp file) file)
(bound-and-true-p byte-compile-current-file))))
;;;; Defined in env.el
;;* UNTESTED
(compat-defmacro with-environment-variables (variables &rest body)
"Set VARIABLES in the environent and execute BODY.
VARIABLES is a list of variable settings of the form (VAR VALUE),
where VAR is the name of the variable (a string) and VALUE
is its value (also a string).
The previous values will be be restored upon exit."
(declare (indent 1) (debug (sexp body)))
(unless (consp variables)
(error "Invalid VARIABLES: %s" variables))
`(let ((process-environment (copy-sequence process-environment)))
,@(mapcar (lambda (elem)
`(setenv ,(car elem) ,(cadr elem)))
variables)
,@body))
;;;; Defined in button.el
;;* UNTESTED
(compat-defun button-buttonize (string callback &optional data)
"Make STRING into a button and return it.
When clicked, CALLBACK will be called with the DATA as the
function argument. If DATA isn't present (or is nil), the button
itself will be used instead as the function argument."
:feature 'button
(propertize string
'face 'button
'button t
'follow-link t
'category t
'button-data data
'keymap button-map
'action callback))
;;;; Defined in autoload.el
(defvar generated-autoload-file)
;;* UNTESTED
(compat-defun make-directory-autoloads (dir output-file)
"Update autoload definitions for Lisp files in the directories DIRS.
DIR can be either a single directory or a list of
directories. (The latter usage is discouraged.)
The autoloads will be written to OUTPUT-FILE. If any Lisp file
binds `generated-autoload-file' as a file-local variable, write
its autoloads into the specified file instead.
The function does NOT recursively descend into subdirectories of the
directory or directories specified."
(let ((generated-autoload-file output-file))
;; We intentionally don't sharp-quote
;; `update-directory-autoloads', because it was deprecated in
;; Emacs 28 and we don't want to trigger the byte compiler for
;; newer versions.
(apply 'update-directory-autoloads
(if (listp dir) dir (list dir)))))
(provide 'compat-28)
;;; compat-28.el ends here

35
code/elpa/compat-28.1.1.0/compat-autoloads.el Normal file
View file

@ -0,0 +1,35 @@
;;; compat-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*-
;;
;;; Code:
(add-to-list 'load-path (directory-file-name
(or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil "compat-help" "compat-help.el" (0 0 0 0))
;;; Generated autoloads from compat-help.el
(register-definition-prefixes "compat-help" '("compat---describe"))
;;;***
;;;### (autoloads nil "compat-macs" "compat-macs.el" (0 0 0 0))
;;; Generated autoloads from compat-macs.el
(register-definition-prefixes "compat-macs" '("compat-"))
;;;***
;;;### (autoloads nil nil ("compat-24.el" "compat-25.el" "compat-26.el"
;;;;;; "compat-27.el" "compat-28.el" "compat-font-lock.el" "compat-pkg.el"
;;;;;; "compat.el") (0 0 0 0))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; compat-autoloads.el ends here

48
code/elpa/compat-28.1.1.0/compat-font-lock.el Normal file
View file

@ -0,0 +1,48 @@
;;; compat-font-lock.el --- -*- lexical-binding: t; -*-
;; Copyright (C) 2022 Free Software Foundation, Inc.
;; Author: Philip Kaludercic <philipk@posteo.net>
;; Keywords:
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Optional font-locking for `compat' definitions. Every symbol with
;; an active compatibility definition will be highlighted.
;;
;; Load this file to enable the functionality.
;;; Code:
(eval-and-compile
(require 'cl-lib)
(require 'compat-macs))
(defvar compat-generate-common-fn)
(let ((compat-generate-common-fn
(lambda (name _def-fn _install-fn check-fn attr _type)
(unless (and (plist-get attr :no-highlight)
(funcall check-fn))
`(font-lock-add-keywords
'emacs-lisp-mode
',`((,(concat "\\_<\\("
(regexp-quote (symbol-name name))
"\\)\\_>")
1 font-lock-preprocessor-face prepend)))))))
(load "compat"))
(provide 'compat-font-lock)
;;; compat-font-lock.el ends here

57
code/elpa/compat-28.1.1.0/compat-help.el Normal file
View file

@ -0,0 +1,57 @@
;;; compat-help.el --- Documentation for compat functions -*- lexical-binding: t; -*-
;; Copyright (C) 2022 Free Software Foundation, Inc.
;; Author: Philip Kaludercic <philipk@posteo.net>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Load this file to insert `compat'-relevant documentation next to
;; the regular documentation of a symbol.
;;; Code:
(defun compat---describe (symbol)
"Insert documentation for SYMBOL if it has compatibility code."
(let ((compat (get symbol 'compat-def)))
(when compat
(let ((doc (get compat 'compat-doc))
(start (point)))
(when doc
(insert "There is a ")
(insert-button
"compatibility notice"
'action (let ((type (get compat 'compat-type)))
(cond
((memq type '(func macro advice))
#'find-function)
((memq type '(variable))
#'find-variable)
((error "Unknown type"))))
'button-data compat)
(insert (format " for %s (for versions of Emacs before %s):"
(symbol-name symbol)
(get compat 'compat-version)))
(add-text-properties start (point) '(face bold))
(newline 2)
(insert (substitute-command-keys doc))
(fill-region start (point))
(newline 2))))))
(add-hook 'help-fns-describe-function-functions #'compat---describe)
(provide 'compat-help)
;;; compat-help.el ends here

367
code/elpa/compat-28.1.1.0/compat-macs.el Normal file
View file

@ -0,0 +1,367 @@
;;; compat-macs.el --- Compatibility Macros -*- lexical-binding: t; -*-
;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
;; Author: Philip Kaludercic <philipk@posteo.net>
;; Keywords: lisp
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; These macros are used to define compatibility functions, macros and
;; advice.
;;; Code:
(defmacro compat--ignore (&rest _)
"Ignore all arguments."
nil)
(defvar compat--generate-function #'compat--generate-minimal
"Function used to generate compatibility code.
The function must take six arguments: NAME, DEF-FN, INSTALL-FN,
CHECK-FN, ATTR and TYPE. The resulting body is constructed by
invoking the functions DEF-FN (passed the \"realname\" and the
version number, returning the compatibility definition), the
INSTALL-FN (passed the \"realname\" and returning the
installation code), CHECK-FN (passed the \"realname\" and
returning a check to see if the compatibility definition should
be installed). ATTR is a plist used to modify the generated
code. The following attributes are handled, all others are
ignored:
- :min-version :: Prevent the compatibility definition from begin
installed in versions older than indicated (string).
- :max-version :: Prevent the compatibility definition from begin
installed in versions newer than indicated (string).
- :feature :: The library the code is supposed to be loaded
with (via `eval-after-load').
- :cond :: Only install the compatibility code, iff the value
evaluates to non-nil.
For prefixed functions, this can be interpreted as a test to
`defalias' an existing definition or not.
- :no-highlight :: Do not highlight this definition as
compatibility function.
- :version :: Manual specification of the version the compatee
code was defined in (string).
- :realname :: Manual specification of a \"realname\" to use for
the compatibility definition (symbol).
- :notes :: Additional notes that a developer using this
compatibility function should keep in mind.
- :prefix :: Add a `compat-' prefix to the name, and define the
compatibility code unconditionally.
TYPE is used to set the symbol property `compat-type' for NAME.")
(defun compat--generate-minimal (name def-fn install-fn check-fn attr type)
"Generate a leaner compatibility definition.
See `compat-generate-function' for details on the arguments NAME,
DEF-FN, INSTALL-FN, CHECK-FN, ATTR and TYPE."
(let* ((min-version (plist-get attr :min-version))
(max-version (plist-get attr :max-version))
(feature (plist-get attr :feature))
(cond (plist-get attr :cond))
(version (or (plist-get attr :version)
(let ((file (or (bound-and-true-p byte-compile-current-file)
load-file-name
(buffer-file-name))))
;; Guess the version from the file the macro is
;; being defined in.
(cond
((not file) emacs-version)
((string-match
"compat-\\([[:digit:]]+\\)\\.\\(?:elc?\\)\\'"
file)
(match-string 1 file))
((error "No version number could be extracted"))))))
(realname (or (plist-get attr :realname)
(intern (format "compat--%S" name))))
(check (cond
((or (and min-version
(version< emacs-version min-version))
(and max-version
(version< max-version emacs-version)))
'(compat--ignore))
((plist-get attr :prefix)
'(progn))
((and version (version<= version emacs-version) (not cond))
'(compat--ignore))
(`(when (and ,(if cond cond t)
,(funcall check-fn)))))))
(cond
((and (plist-get attr :prefix) (memq type '(func macro))
(string-match "\\`compat-\\(.+\\)\\'" (symbol-name name))
(let* ((actual-name (intern (match-string 1 (symbol-name name))))
(body (funcall install-fn actual-name version)))
(when (and (version<= version emacs-version)
(fboundp actual-name))
`(,@check
,(if feature
;; See https://nullprogram.com/blog/2018/02/22/:
`(eval-after-load ,feature `(funcall ',(lambda () ,body)))
body))))))
((plist-get attr :realname)
`(progn
,(funcall def-fn realname version)
(,@check
,(let ((body (funcall install-fn realname version)))
(if feature
;; See https://nullprogram.com/blog/2018/02/22/:
`(eval-after-load ,feature `(funcall ',(lambda () ,body)))
body)))))
((let* ((body (if (eq type 'advice)
`(,@check
,(funcall def-fn realname version)
,(funcall install-fn realname version))
`(,@check ,(funcall def-fn name version)))))
(if feature
;; See https://nullprogram.com/blog/2018/02/22/:
`(eval-after-load ,feature `(funcall ',(lambda () ,body)))
body))))))
(defun compat--generate-minimal-no-prefix (name def-fn install-fn check-fn attr type)
"Generate a leaner compatibility definition.
See `compat-generate-function' for details on the arguments NAME,
DEF-FN, INSTALL-FN, CHECK-FN, ATTR and TYPE."
(unless (plist-get attr :prefix)
(compat--generate-minimal name def-fn install-fn check-fn attr type)))
(defun compat--generate-verbose (name def-fn install-fn check-fn attr type)
"Generate a more verbose compatibility definition, fit for testing.
See `compat-generate-function' for details on the arguments NAME,
DEF-FN, INSTALL-FN, CHECK-FN, ATTR and TYPE."
(let* ((min-version (plist-get attr :min-version))
(max-version (plist-get attr :max-version))
(feature (plist-get attr :feature))
(cond (plist-get attr :cond))
(version (or (plist-get attr :version)
(let ((file (or (bound-and-true-p byte-compile-current-file)
load-file-name
(buffer-file-name))))
;; Guess the version from the file the macro is
;; being defined in.
(cond
((not file) emacs-version)
((string-match
"compat-\\([[:digit:]]+\\)\\.\\(?:elc?\\)\\'"
file)
(match-string 1 file))
((error "No version number could be extracted"))))))
(realname (or (plist-get attr :realname)
(intern (format "compat--%S" name))))
(body `(progn
(unless (or (null (get ',name 'compat-def))
(eq (get ',name 'compat-def) ',realname))
(error "Duplicate compatibility definition: %s (was %s, now %s)"
',name (get ',name 'compat-def) ',realname))
(put ',name 'compat-def ',realname)
,(funcall install-fn realname version))))
`(progn
(put ',realname 'compat-type ',type)
(put ',realname 'compat-version ,version)
(put ',realname 'compat-min-version ,min-version)
(put ',realname 'compat-max-version ,max-version)
(put ',realname 'compat-doc ,(plist-get attr :note))
,(funcall def-fn realname version)
(,@(cond
((or (and min-version
(version< emacs-version min-version))
(and max-version
(version< max-version emacs-version)))
'(compat--ignore))
((plist-get attr :prefix)
'(progn))
((and version (version<= version emacs-version) (not cond))
'(compat--ignore))
(`(when (and ,(if cond cond t)
,(funcall check-fn)))))
,(if feature
;; See https://nullprogram.com/blog/2018/02/22/:
`(eval-after-load ,feature `(funcall ',(lambda () ,body)))
body)))))
(defun compat-generate-common (name def-fn install-fn check-fn attr type)
"Common code for generating compatibility definitions.
See `compat-generate-function' for details on the arguments NAME,
DEF-FN, INSTALL-FN, CHECK-FN, ATTR and TYPE."
(when (and (plist-get attr :cond) (plist-get attr :prefix))
(error "A prefixed function %s cannot have a condition" name))
(funcall compat--generate-function
name def-fn install-fn check-fn attr type))
(defun compat-common-fdefine (type name arglist docstring rest)
"Generate compatibility code for a function NAME.
TYPE is one of `func', for functions and `macro' for macros, and
`advice' ARGLIST is passed on directly to the definition, and
DOCSTRING is prepended with a compatibility note. REST contains
the remaining definition, that may begin with a property list of
attributes (see `compat-generate-common')."
(let ((oldname name) (body rest))
(while (keywordp (car body))
(setq body (cddr body)))
;; It might be possible to set these properties otherwise. That
;; should be looked into and implemented if it is the case.
(when (and (listp (car-safe body)) (eq (caar body) 'declare))
(when (version<= emacs-version "25")
(delq (assq 'side-effect-free (car body)) (car body))
(delq (assq 'pure (car body)) (car body))))
;; Check if we want an explicitly prefixed function
(when (plist-get rest :prefix)
(setq name (intern (format "compat-%s" name))))
(compat-generate-common
name
(lambda (realname version)
`(,(cond
((memq type '(func advice)) 'defun)
((eq type 'macro) 'defmacro)
((error "Unknown type")))
,realname ,arglist
;; Prepend compatibility notice to the actual
;; documentation string.
,(let ((type (cond
((eq type 'func) "function")
((eq type 'macro) "macro")
((eq type 'advice) "advice")
((error "Unknown type")))))
(if version
(format
"[Compatibility %s for `%S', defined in Emacs %s]\n\n%s"
type oldname version docstring)
(format
"[Compatibility %s for `%S']\n\n%s"
type oldname docstring)))
;; Advice may use the implicit variable `oldfun', but
;; to avoid triggering the byte compiler, we make
;; sure the argument is used at least once.
,@(if (eq type 'advice)
(cons '(ignore oldfun) body)
body)))
(lambda (realname _version)
(cond
((memq type '(func macro))
;; Functions and macros are installed by
;; aliasing the name of the compatible
;; function to the name of the compatibility
;; function.
`(defalias ',name #',realname))
((eq type 'advice)
`(advice-add ',name :around #',realname))))
(lambda ()
(cond
((memq type '(func macro))
`(not (fboundp ',name)))
((eq type 'advice) t)))
rest type)))
(defmacro compat-defun (name arglist docstring &rest rest)
"Define NAME with arguments ARGLIST as a compatibility function.
The function must be documented in DOCSTRING. REST may begin
with a plist, that is interpreted by the macro but not passed on
to the actual function. See `compat-generate-common' for a
listing of attributes.
The definition will only be installed, if the version this
function was defined in, as indicated by the `:version'
attribute, is greater than the current Emacs version."
(declare (debug (&define name (&rest symbolp)
stringp
[&rest keywordp sexp]
def-body))
(doc-string 3) (indent 2))
(compat-common-fdefine 'func name arglist docstring rest))
(defmacro compat-defmacro (name arglist docstring &rest rest)
"Define NAME with arguments ARGLIST as a compatibility macro.
The macro must be documented in DOCSTRING. REST may begin
with a plist, that is interpreted by this macro but not passed on
to the actual macro. See `compat-generate-common' for a
listing of attributes.
The definition will only be installed, if the version this
function was defined in, as indicated by the `:version'
attribute, is greater than the current Emacs version."
(declare (debug compat-defun) (doc-string 3) (indent 2))
(compat-common-fdefine 'macro name arglist docstring rest))
(defmacro compat-advise (name arglist docstring &rest rest)
"Define NAME with arguments ARGLIST as a compatibility advice.
The advice function must be documented in DOCSTRING. REST may
begin with a plist, that is interpreted by this macro but not
passed on to the actual advice function. See
`compat-generate-common' for a listing of attributes. The advice
wraps the old definition, that is accessible via using the symbol
`oldfun'.
The advice will only be installed, if the version this function
was defined in, as indicated by the `:version' attribute, is
greater than the current Emacs version."
(declare (debug compat-defun) (doc-string 3) (indent 2))
(compat-common-fdefine 'advice name (cons 'oldfun arglist) docstring rest))
(defmacro compat-defvar (name initval docstring &rest attr)
"Declare compatibility variable NAME with initial value INITVAL.
The obligatory documentation string DOCSTRING must be given.
The remaining arguments ATTR form a plist, modifying the
behaviour of this macro. See `compat-generate-common' for a
listing of attributes. Furthermore, `compat-defvar' also handles
the attribute `:local' that either makes the variable permanent
local with a value of `permanent' or just buffer local with any
non-nil value."
(declare (debug (name form stringp [&rest keywordp sexp]))
(doc-string 3) (indent 2))
;; Check if we want an explicitly prefixed function
(let ((oldname name))
(when (plist-get attr :prefix)
(setq name (intern (format "compat-%s" name))))
(compat-generate-common
name
(lambda (realname version)
(let ((localp (plist-get attr :local)))
`(progn
(,(if (plist-get attr :constant) 'defconst 'defvar)
,realname ,initval
;; Prepend compatibility notice to the actual
;; documentation string.
,(if version
(format
"[Compatibility variable for `%S', defined in Emacs %s]\n\n%s"
oldname version docstring)
(format
"[Compatibility variable for `%S']\n\n%s"
oldname docstring)))
;; Make variable as local if necessary
,(cond
((eq localp 'permanent)
`(put ',realname 'permanent-local t))
(localp
`(make-variable-buffer-local ',realname))))))
(lambda (realname _version)
`(defvaralias ',name ',realname))
(lambda ()
`(not (boundp ',name)))
attr 'variable)))
(provide 'compat-macs)
;;; compat-macs.el ends here

2
code/elpa/compat-28.1.1.0/compat-pkg.el Normal file
View file

@ -0,0 +1,2 @@
;; Generated package description from compat.el -*- no-byte-compile: t -*-
(define-package "compat" "28.1.1.0" "Compatibility Library" '((emacs "24.3") (nadvice "0.3")) :commit "401df6defaf5ef470a2dc57664b2d258662a5c3d" :authors '(("Philip Kaludercic" . "philipk@posteo.net")) :maintainer '("Compat Development" . "~pkal/compat-devel@lists.sr.ht") :keywords '("lisp") :url "https://sr.ht/~pkal/compat")

99
code/elpa/compat-28.1.1.0/compat.el Normal file
View file

@ -0,0 +1,99 @@
;;; compat.el --- Compatibility Library -*- lexical-binding: t; -*-
;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
;; Author: Philip Kaludercic <philipk@posteo.net>
;; Maintainer: Compat Development <~pkal/compat-devel@lists.sr.ht>
;; Version: 28.1.1.0
;; URL: https://sr.ht/~pkal/compat
;; Package-Requires: ((emacs "24.3") (nadvice "0.3"))
;; Keywords: lisp
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; To allow for the usage of Emacs functions and macros that are
;; defined in newer versions of Emacs, compat.el provides definitions
;; that are installed ONLY if necessary. These reimplementations of
;; functions and macros are at least subsets of the actual
;; implementations. Be sure to read the documentation string to make
;; sure.
;;
;; Not every function provided in newer versions of Emacs is provided
;; here. Some depend on new features from the core, others cannot be
;; implemented to a meaningful degree. The main audience for this
;; library are not regular users, but package maintainers. Therefore
;; commands and user options are usually not implemented here.
;;; Code:
(eval-when-compile (require 'compat-macs))
;;;; Core functionality
;; To accelerate the loading process, we insert the contents of
;; compat-N.M.el directly into the compat.elc. Note that by default
;; this will not include prefix functions. These have to be required
;; separately, by explicitly requiring the feature that defines them.
(eval-when-compile
(defvar compat--generate-function)
(defmacro compat-entwine (version)
(cond
((or (not (eq compat--generate-function 'compat--generate-minimal))
(bound-and-true-p compat-testing))
`(load ,(format "compat-%d.el" version)))
((let* ((compat--generate-function 'compat--generate-minimal-no-prefix)
(file (expand-file-name
(format "compat-%d.el" version)
(file-name-directory
(or (if (fboundp 'macroexp-file-name)
(macroexp-file-name)
(or (bound-and-true-p byte-compile-current-file)
load-file-name))
(buffer-file-name)))))
defs)
(with-temp-buffer
(insert-file-contents file)
(emacs-lisp-mode)
(while (progn
(forward-comment 1)
(not (eobp)))
;; We bind `byte-compile-current-file' before
;; macro-expanding, so that `compat--generate-function'
;; can correctly infer the compatibility version currently
;; being processed.
(let ((byte-compile-current-file file)
(form (read (current-buffer))))
(cond
((memq (car-safe form)
'(compat-defun
compat-defmacro
compat-advise
compat-defvar))
(push (macroexpand-all form) defs))
((memq (car-safe form)
'(declare-function
defvar))
(push form defs))))))
(macroexp-progn (nreverse defs)))))))
(compat-entwine 24)
(compat-entwine 25)
(compat-entwine 26)
(compat-entwine 27)
(compat-entwine 28)
(provide 'compat)
;;; compat.el ends here

1110
code/elpa/compat-28.1.1.0/compat.info Normal file
View file

File diff suppressed because it is too large Load diff

18
code/elpa/compat-28.1.1.0/dir Normal file
View file

@ -0,0 +1,18 @@
This is the file .../info/dir, which contains the
topmost node of the Info hierarchy, called (dir)Top.
The first time you invoke Info you start off looking at this node.

File: dir, Node: Top This is the top of the INFO tree
This (the Directory node) gives a menu of major topics.
Typing "q" exits, "H" lists all Info commands, "d" returns here,
"h" gives a primer for first-timers,
"mEmacs<Return>" visits the Emacs manual, etc.
In Emacs, you can click mouse button 2 on a menu item or cross reference
to select it.
* Menu:
Emacs
* Compat: (compat). Compatibility Library for Emacs Lisp.

33
code/elpa/git-commit-20220422.1903/git-commit-autoloads.el Normal file
View file

@ -0,0 +1,33 @@
;;; git-commit-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*-
;;
;;; Code:
(add-to-list 'load-path (directory-file-name
(or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil "git-commit" "git-commit.el" (0 0 0 0))
;;; Generated autoloads from git-commit.el
(put 'git-commit-major-mode 'safe-local-variable
(lambda (val)
(memq val '(text-mode
markdown-mode
org-mode
fundamental-mode
git-commit-elisp-text-mode))))
(register-definition-prefixes "git-commit" '("git-commit-" "global-git-commit-mode"))
;;;***
;;;### (autoloads nil nil ("git-commit-pkg.el") (0 0 0 0))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; git-commit-autoloads.el ends here

18
code/elpa/git-commit-20220422.1903/git-commit-pkg.el Normal file
View file

@ -0,0 +1,18 @@
(define-package "git-commit" "20220422.1903" "Edit Git commit messages."
'((emacs "25.1")
(compat "28.1.0.4")
(transient "20210920")
(with-editor "20211001"))
:commit "3cb7f5ba430906bded9e5d9951f5260ab25644d0" :authors
'(("Jonas Bernoulli" . "jonas@bernoul.li")
("Sebastian Wiesner" . "lunaryorn@gmail.com")
("Florian Ragwitz" . "rafl@debian.org")
("Marius Vollmer" . "marius.vollmer@gmail.com"))
:maintainer
'("Jonas Bernoulli" . "jonas@bernoul.li")
:keywords
'("git" "tools" "vc")
:url "https://github.com/magit/magit")
;; Local Variables:
;; no-byte-compile: t
;; End:

1141
code/elpa/git-commit-20220422.1903/git-commit.el Normal file
View file

File diff suppressed because it is too large Load diff

393
code/elpa/magit-20220425.1153/AUTHORS.md Normal file
View file

@ -0,0 +1,393 @@
Authors
=======
The following people have contributed to Magit, including the
libraries `git-commit.el`, `magit-popup.el`, and `with-editor.el`
which are distributed as separate Elpa packages.
For statistics see https://magit.vc/stats/authors.html.
Names below are sorted alphabetically.
Author
------
- Marius Vollmer
Maintainer
----------
- Jonas Bernoulli
Developers
----------
- Kyle Meyer
- Noam Postavsky
Retired Maintainers and Developers
----------------------------------
- Nicolas Dudebout
- Peter J. Weisberg
- Pieter Praet
- Phil Jackson
- Rémi Vanicat
- Yann Hodique
Contributors
------------
- Aaron Culich
- Aaron L. Zeng
- Aaron Madlon-Kay
- Abdo Roig-Maranges
- Adam Benanti
- Adam Kruszewski
- Adam Porter
- Adam Spiers
- Adeodato Simó
- Ævar Arnfjörð Bjarmason
- Alan Falloon
- Alban Gruin
- Aleksey Uimanov
- Alexander Gramiak
- Alexander Miller
- Alex Branham
- Alex Dunn
- Alexey Voinov
- Alex Kost
- Alex Ott
- Allen Li
- Andreas Fuchs
- Andreas Liljeqvist
- Andreas Rottmann
- Andrei Chițu
- Andrew Eggenberger
- Andrew Kirkpatrick
- Andrew Psaltis
- Andrew Schwartzmeyer
- Andrey Smirnov
- Andriy Kmit'
- Andy Sawyer
- Angel de Vicente
- Aria Edmonds
- Arialdo Martini
- Arnau Roig Ninerola
- Ashlynn Anderson
- Barak A. Pearlmutter
- Bar Magal
- Bart Bakker
- Basil L. Contovounesios
- Bastian Beischer
- Bastian Beranek
- Benjamin Motz
- Ben North
- Ben Walton
- Bob Uhl
- Boruch Baum
- Bradley Wright
- Brandon W Maister
- Brennan Vincent
- Brian Leung
- Brian Warner
- Bryan Shell
- Buster Copley
- Cameron Chaparro
- Carl Lieberman
- Chillar Anand
- Chris Bernard
- Chris Done
- Chris LaRose
- Chris Moore
- Chris Ring
- Chris Shoemaker
- Christian Dietrich
- Christian Kluge
- Christophe Junke
- Christopher Monsanto
- Clément Pit-Claudel
- Cornelius Mika
- Craig Andera
- Dale Hagglund
- Damien Cassou
- Dan Davison
- Dan Erikson
- Daniel Brockman
- Daniel Farina
- Daniel Fleischer
- Daniel Gröber
- Daniel Hackney
- Daniel Kraus
- Daniel Mai
- Daniel Martín
- Daniel Nagy
- Dan Kessler
- Dan LaManna
- Danny Zhu
- Dato Simó
- David Abrahams
- David Ellison
- David Hull
- David L. Rager
- David Wallin
- Dean Kariniemi
- Dennis Paskorz
- Divye Kapoor
- Dominique Quatravaux
- Duianto Vebotci
- Eli Barzilay
- Eric
- Eric Davis
- Eric Prud'hommeaux
- Eric Schulte
- Erik Anderson
- Evan Torrie
- Evgkeni Sampelnikof
- Eyal Lotem
- Fabian Wiget
- Felix Geller
- Felix Yan
- Feng Li
- Florian Ragwitz
- Franklin Delehelle
- Frédéric Giquel
- Fritz Grabo
- Fritz Stelzer
- Geoff Shannon
- George Kadianakis
- Géza Herman
- Graham Clark
- Graham Dobbins
- Greg A. Woods
- Greg Lucas
- Gregory Heytings
- Greg Sexton
- Greg Steuck
- Guillaume Martres
- Hannu Koivisto
- Hans-Peter Deifel
- Hussein Ait-Lahcen
- Ian Eure
- Ian Milligan
- Ilya Grigoriev
- Ingmar Sittl
- Ingo Lohmar
- Ioan-Adrian Ratiu
- Ivan Brennan
- Jan Tatarik
- Jasper St. Pierre
- Jeff Bellegarde
- Jeff Dairiki
- Jeremy Meng
- Jesse Alama
- Jim Blandy
- Joakim Jalap
- Johannes Altmanninger
- Johann Klähn
- John Mastro
- John Morris
- John Wiegley
- Jonas Bernoulli
- Jonas Galvão Xavier
- Jonathan Arnett
- Jonathan del Strother
- Jonathan Leech-Pepin
- Jonathan Roes
- Jonathon McKitrick
- Jon Vanderwijk
- Jordan Galby
- Jordan Greenberg
- Jorge Israel Peña
- Josh Elsasser
- Josiah Schwab
- Julien Danjou
- Justin Burkett
- Justin Caratzas
- Justin Guenther
- Justin Thomas
- Kan-Ru Chen
- Kenny Ballou
- Keshav Kini
- Kevin Brubeck Unhammer
- Kevin J. Foley
- Kévin Le Gouguec
- Kimberly Wolk
- Knut Olav Bøhmer
- Kyle Meyer
- Laurent Laffont
- Laverne Schrock
- Leandro Facchinetti
- Lele Gaifax
- Leo Liu
- Leonardo Etcheverry
- Leo Vivier
- Lingchao Xin
- Lin Sun
- Li-Yun Chang
- Lluís Vilanova
- Loic Dachary
- Louis Roché
- Luís Oliveira
- Luke Amdor
- Magnus Malm
- Mak Kolybabi
- Manuel Vázquez Acosta
- Marcel Wolf
- Marc Herbert
- Marcin Bachry
- Marco Craveiro
- Marco Wahl
- Marc Sherry
- Marian Schubert
- Mario Rodas
- Marius Vollmer
- Mark Hepburn
- Mark Karpov
- Mark Oteiza
- Martin Joerg
- Martin Polden
- Matthew Fluet
- Matthew Kraai
- Matthieu Hauglustaine
- Matus Goljer
- Maxim Cournoyer
- Michael Fogleman
- Michael Griffiths
- Michael Heerdegen
- Michal Sojka
- Miciah Masters
- Miles Bader
- Miloš Mošić
- Mitchel Humpherys
- Moritz Bunkus
- Naoya Yamashita
- Natalie Weizenbaum
- Nguyễn Tuấn Anh
- Nic Ferier
- Nick Alcock
- Nick Alexander
- Nick Dimiduk
- Nicklas Lindgren
- Nicolas Dudebout
- Nicolas Petton
- Nicolas Richard
- Nikolay Martynov
- Noam Postavsky
- N. Troy de Freitas
- Ola x Nilsson
- Ole Arndt
- Oleh Krehel
- Orivej Desh
- Óscar Fuentes
- Pancho Horrillo
- Paul Stadig
- Pavel Holejsovsky
- Pekka Pessi
- Peter Eisentraut
- Peter Jaros
- Peter J. Weisberg
- Peter Vasil
- Philippe Cavalaria
- Philippe Vaucher
- Philipp Fehre
- Philipp Haselwarter
- Philipp Stephani
- Philip Weaver
- Phil Jackson
- Phil Sainty
- Pierre Neidhardt
- Pieter Praet
- Prathamesh Sonpatki
- Pritam Baral
- rabio
- Radon Rosborough
- Rafael Laboissiere
- Raimon Grau
- Ramkumar Ramachandra
- Remco van 't Veer
- Rémi Vanicat
- René Stadler
- Richard Kim
- Robert Boone
- Robin Green
- Roey Darwish Dror
- Roger Crew
- Romain Francoise
- Ron Parker
- Roy Crihfield
- Rüdiger Sonderfeld
- Russell Black
- Ryan C. Thompson
- Sam Cedarbaum
- Samuel Bronson
- Samuel W. Flint
- Sanjoy Das
- Sean Allred
- Sean Bryant
- Sean Whitton
- Sebastian Wiesner
- Sébastien Gross
- Seong-Kook Shin
- Sergey Pashinin
- Sergey Vinokurov
- Servilio Afre Puentes
- Shuguang Sun
- Siavash Askari Nasr
- Silent Sphere
- Simon Pintarelli
- Stefan Kangas
- Štěpán Němec
- Steven Chow
- Steven E. Harris
- Steven Thomas
- Steven Vancoillie
- Steve Purcell
- Suhail Shergill
- Sylvain Rousseau
- Syohei Yoshida
- Szunti
- Takafumi Arakaki
- Tassilo Horn
- TEC
- Teemu Likonen
- Teruki Shigitani
- Thierry Volpiatto
- Thomas A Caswell
- Thomas Fini Hansen
- Thomas Frössman
- Thomas Jost
- Thomas Riccardi
- Tibor Simko
- Timo Juhani Lindfors
- Tim Perkins
- Tim Wraight
- Ting-Yu Lin
- Tom Feist
- Toon Claes
- Topi Miettinen
- Troy Hinckley
- Tsuyoshi Kitamoto
- Tunc Uzlu
- Vineet Naik
- Vitaly Ostashov
- Vladimir Ivanov
- Vladimir Panteleev
- Vladimir Sedach
- Wei Huang
- Wilfred Hughes
- Win Treese
- Wojciech Siewierski
- Wouter Bolsterlee
- Xavier Noria
- Xu Chunyang
- Yann Herklotz
- Yann Hodique
- Ynilu
- York Zhao
- Yuichi Higashi
- Yuri Khan
- Zach Latta
- zakora
- Zhu Zihao
- zilongshanren

674
code/elpa/magit-20220425.1153/LICENSE Normal file
View file

@ -0,0 +1,674 @@
GNU GENERAL PUBLIC LICENSE
Version 3, 29 June 2007
Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/>
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The GNU General Public License is a free, copyleft license for
software and other kinds of works.
The licenses for most software and other practical works are designed
to take away your freedom to share and change the works. By contrast,
the GNU General Public License is intended to guarantee your freedom to
share and change all versions of a program--to make sure it remains free
software for all its users. We, the Free Software Foundation, use the
GNU General Public License for most of our software; it applies also to
any other work released this way by its authors. You can apply it to
your programs, too.
When we speak of free software, we are referring to freedom, not
price. Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
them if you wish), that you receive source code or can get it if you
want it, that you can change the software or use pieces of it in new
free programs, and that you know you can do these things.
To protect your rights, we need to prevent others from denying you
these rights or asking you to surrender the rights. Therefore, you have
certain responsibilities if you distribute copies of the software, or if
you modify it: responsibilities to respect the freedom of others.
For example, if you distribute copies of such a program, whether
gratis or for a fee, you must pass on to the recipients the same
freedoms that you received. You must make sure that they, too, receive
or can get the source code. And you must show them these terms so they
know their rights.
Developers that use the GNU GPL protect your rights with two steps:
(1) assert copyright on the software, and (2) offer you this License
giving you legal permission to copy, distribute and/or modify it.
For the developers' and authors' protection, the GPL clearly explains
that there is no warranty for this free software. For both users' and
authors' sake, the GPL requires that modified versions be marked as
changed, so that their problems will not be attributed erroneously to
authors of previous versions.
Some devices are designed to deny users access to install or run
modified versions of the software inside them, although the manufacturer
can do so. This is fundamentally incompatible with the aim of
protecting users' freedom to change the software. The systematic
pattern of such abuse occurs in the area of products for individuals to
use, which is precisely where it is most unacceptable. Therefore, we
have designed this version of the GPL to prohibit the practice for those
products. If such problems arise substantially in other domains, we
stand ready to extend this provision to those domains in future versions
of the GPL, as needed to protect the freedom of users.
Finally, every program is threatened constantly by software patents.
States should not allow patents to restrict development and use of
software on general-purpose computers, but in those that do, we wish to
avoid the special danger that patents applied to a free program could
make it effectively proprietary. To prevent this, the GPL assures that
patents cannot be used to render the program non-free.
The precise terms and conditions for copying, distribution and
modification follow.
TERMS AND CONDITIONS
0. Definitions.
"This License" refers to version 3 of the GNU General Public License.
"Copyright" also means copyright-like laws that apply to other kinds of
works, such as semiconductor masks.
"The Program" refers to any copyrightable work licensed under this
License. Each licensee is addressed as "you". "Licensees" and
"recipients" may be individuals or organizations.
To "modify" a work means to copy from or adapt all or part of the work
in a fashion requiring copyright permission, other than the making of an
exact copy. The resulting work is called a "modified version" of the
earlier work or a work "based on" the earlier work.
A "covered work" means either the unmodified Program or a work based
on the Program.
To "propagate" a work means to do anything with it that, without
permission, would make you directly or secondarily liable for
infringement under applicable copyright law, except executing it on a
computer or modifying a private copy. Propagation includes copying,
distribution (with or without modification), making available to the
public, and in some countries other activities as well.
To "convey" a work means any kind of propagation that enables other
parties to make or receive copies. Mere interaction with a user through
a computer network, with no transfer of a copy, is not conveying.
An interactive user interface displays "Appropriate Legal Notices"
to the extent that it includes a convenient and prominently visible
feature that (1) displays an appropriate copyright notice, and (2)
tells the user that there is no warranty for the work (except to the
extent that warranties are provided), that licensees may convey the
work under this License, and how to view a copy of this License. If
the interface presents a list of user commands or options, such as a
menu, a prominent item in the list meets this criterion.
1. Source Code.
The "source code" for a work means the preferred form of the work
for making modifications to it. "Object code" means any non-source
form of a work.
A "Standard Interface" means an interface that either is an official
standard defined by a recognized standards body, or, in the case of
interfaces specified for a particular programming language, one that
is widely used among developers working in that language.
The "System Libraries" of an executable work include anything, other
than the work as a whole, that (a) is included in the normal form of
packaging a Major Component, but which is not part of that Major
Component, and (b) serves only to enable use of the work with that
Major Component, or to implement a Standard Interface for which an
implementation is available to the public in source code form. A
"Major Component", in this context, means a major essential component
(kernel, window system, and so on) of the specific operating system
(if any) on which the executable work runs, or a compiler used to
produce the work, or an object code interpreter used to run it.
The "Corresponding Source" for a work in object code form means all
the source code needed to generate, install, and (for an executable
work) run the object code and to modify the work, including scripts to
control those activities. However, it does not include the work's
System Libraries, or general-purpose tools or generally available free
programs which are used unmodified in performing those activities but
which are not part of the work. For example, Corresponding Source
includes interface definition files associated with source files for
the work, and the source code for shared libraries and dynamically
linked subprograms that the work is specifically designed to require,
such as by intimate data communication or control flow between those
subprograms and other parts of the work.
The Corresponding Source need not include anything that users
can regenerate automatically from other parts of the Corresponding
Source.
The Corresponding Source for a work in source code form is that
same work.
2. Basic Permissions.
All rights granted under this License are granted for the term of
copyright on the Program, and are irrevocable provided the stated
conditions are met. This License explicitly affirms your unlimited
permission to run the unmodified Program. The output from running a
covered work is covered by this License only if the output, given its
content, constitutes a covered work. This License acknowledges your
rights of fair use or other equivalent, as provided by copyright law.
You may make, run and propagate covered works that you do not
convey, without conditions so long as your license otherwise remains
in force. You may convey covered works to others for the sole purpose
of having them make modifications exclusively for you, or provide you
with facilities for running those works, provided that you comply with
the terms of this License in conveying all material for which you do
not control copyright. Those thus making or running the covered works
for you must do so exclusively on your behalf, under your direction
and control, on terms that prohibit them from making any copies of
your copyrighted material outside their relationship with you.
Conveying under any other circumstances is permitted solely under
the conditions stated below. Sublicensing is not allowed; section 10
makes it unnecessary.
3. Protecting Users' Legal Rights From Anti-Circumvention Law.
No covered work shall be deemed part of an effective technological
measure under any applicable law fulfilling obligations under article
11 of the WIPO copyright treaty adopted on 20 December 1996, or
similar laws prohibiting or restricting circumvention of such
measures.
When you convey a covered work, you waive any legal power to forbid
circumvention of technological measures to the extent such circumvention
is effected by exercising rights under this License with respect to
the covered work, and you disclaim any intention to limit operation or
modification of the work as a means of enforcing, against the work's
users, your or third parties' legal rights to forbid circumvention of
technological measures.
4. Conveying Verbatim Copies.
You may convey verbatim copies of the Program's source code as you
receive it, in any medium, provided that you conspicuously and
appropriately publish on each copy an appropriate copyright notice;
keep intact all notices stating that this License and any
non-permissive terms added in accord with section 7 apply to the code;
keep intact all notices of the absence of any warranty; and give all
recipients a copy of this License along with the Program.
You may charge any price or no price for each copy that you convey,
and you may offer support or warranty protection for a fee.
5. Conveying Modified Source Versions.
You may convey a work based on the Program, or the modifications to
produce it from the Program, in the form of source code under the
terms of section 4, provided that you also meet all of these conditions:
a) The work must carry prominent notices stating that you modified
it, and giving a relevant date.
b) The work must carry prominent notices stating that it is
released under this License and any conditions added under section
7. This requirement modifies the requirement in section 4 to
"keep intact all notices".
c) You must license the entire work, as a whole, under this
License to anyone who comes into possession of a copy. This
License will therefore apply, along with any applicable section 7
additional terms, to the whole of the work, and all its parts,
regardless of how they are packaged. This License gives no
permission to license the work in any other way, but it does not
invalidate such permission if you have separately received it.
d) If the work has interactive user interfaces, each must display
Appropriate Legal Notices; however, if the Program has interactive
interfaces that do not display Appropriate Legal Notices, your
work need not make them do so.
A compilation of a covered work with other separate and independent
works, which are not by their nature extensions of the covered work,
and which are not combined with it such as to form a larger program,
in or on a volume of a storage or distribution medium, is called an
"aggregate" if the compilation and its resulting copyright are not
used to limit the access or legal rights of the compilation's users
beyond what the individual works permit. Inclusion of a covered work
in an aggregate does not cause this License to apply to the other
parts of the aggregate.
6. Conveying Non-Source Forms.
You may convey a covered work in object code form under the terms
of sections 4 and 5, provided that you also convey the
machine-readable Corresponding Source under the terms of this License,
in one of these ways:
a) Convey the object code in, or embodied in, a physical product
(including a physical distribution medium), accompanied by the
Corresponding Source fixed on a durable physical medium
customarily used for software interchange.
b) Convey the object code in, or embodied in, a physical product
(including a physical distribution medium), accompanied by a
written offer, valid for at least three years and valid for as
long as you offer spare parts or customer support for that product
model, to give anyone who possesses the object code either (1) a
copy of the Corresponding Source for all the software in the
product that is covered by this License, on a durable physical
medium customarily used for software interchange, for a price no
more than your reasonable cost of physically performing this
conveying of source, or (2) access to copy the
Corresponding Source from a network server at no charge.
c) Convey individual copies of the object code with a copy of the
written offer to provide the Corresponding Source. This
alternative is allowed only occasionally and noncommercially, and
only if you received the object code with such an offer, in accord
with subsection 6b.
d) Convey the object code by offering access from a designated
place (gratis or for a charge), and offer equivalent access to the
Corresponding Source in the same way through the same place at no
further charge. You need not require recipients to copy the
Corresponding Source along with the object code. If the place to
copy the object code is a network server, the Corresponding Source
may be on a different server (operated by you or a third party)
that supports equivalent copying facilities, provided you maintain
clear directions next to the object code saying where to find the
Corresponding Source. Regardless of what server hosts the
Corresponding Source, you remain obligated to ensure that it is
available for as long as needed to satisfy these requirements.
e) Convey the object code using peer-to-peer transmission, provided
you inform other peers where the object code and Corresponding
Source of the work are being offered to the general public at no
charge under subsection 6d.
A separable portion of the object code, whose source code is excluded
from the Corresponding Source as a System Library, need not be
included in conveying the object code work.
A "User Product" is either (1) a "consumer product", which means any
tangible personal property which is normally used for personal, family,
or household purposes, or (2) anything designed or sold for incorporation
into a dwelling. In determining whether a product is a consumer product,
doubtful cases shall be resolved in favor of coverage. For a particular
product received by a particular user, "normally used" refers to a
typical or common use of that class of product, regardless of the status
of the particular user or of the way in which the particular user
actually uses, or expects or is expected to use, the product. A product
is a consumer product regardless of whether the product has substantial
commercial, industrial or non-consumer uses, unless such uses represent
the only significant mode of use of the product.
"Installation Information" for a User Product means any methods,
procedures, authorization keys, or other information required to install
and execute modified versions of a covered work in that User Product from
a modified version of its Corresponding Source. The information must
suffice to ensure that the continued functioning of the modified object
code is in no case prevented or interfered with solely because
modification has been made.
If you convey an object code work under this section in, or with, or
specifically for use in, a User Product, and the conveying occurs as
part of a transaction in which the right of possession and use of the
User Product is transferred to the recipient in perpetuity or for a
fixed term (regardless of how the transaction is characterized), the
Corresponding Source conveyed under this section must be accompanied
by the Installation Information. But this requirement does not apply
if neither you nor any third party retains the ability to install
modified object code on the User Product (for example, the work has
been installed in ROM).
The requirement to provide Installation Information does not include a
requirement to continue to provide support service, warranty, or updates
for a work that has been modified or installed by the recipient, or for
the User Product in which it has been modified or installed. Access to a
network may be denied when the modification itself materially and
adversely affects the operation of the network or violates the rules and
protocols for communication across the network.
Corresponding Source conveyed, and Installation Information provided,
in accord with this section must be in a format that is publicly
documented (and with an implementation available to the public in
source code form), and must require no special password or key for
unpacking, reading or copying.
7. Additional Terms.
"Additional permissions" are terms that supplement the terms of this
License by making exceptions from one or more of its conditions.
Additional permissions that are applicable to the entire Program shall
be treated as though they were included in this License, to the extent
that they are valid under applicable law. If additional permissions
apply only to part of the Program, that part may be used separately
under those permissions, but the entire Program remains governed by
this License without regard to the additional permissions.
When you convey a copy of a covered work, you may at your option
remove any additional permissions from that copy, or from any part of
it. (Additional permissions may be written to require their own
removal in certain cases when you modify the work.) You may place
additional permissions on material, added by you to a covered work,
for which you have or can give appropriate copyright permission.
Notwithstanding any other provision of this License, for material you
add to a covered work, you may (if authorized by the copyright holders of
that material) supplement the terms of this License with terms:
a) Disclaiming warranty or limiting liability differently from the
terms of sections 15 and 16 of this License; or
b) Requiring preservation of specified reasonable legal notices or
author attributions in that material or in the Appropriate Legal
Notices displayed by works containing it; or
c) Prohibiting misrepresentation of the origin of that material, or
requiring that modified versions of such material be marked in
reasonable ways as different from the original version; or
d) Limiting the use for publicity purposes of names of licensors or
authors of the material; or
e) Declining to grant rights under trademark law for use of some
trade names, trademarks, or service marks; or
f) Requiring indemnification of licensors and authors of that
material by anyone who conveys the material (or modified versions of
it) with contractual assumptions of liability to the recipient, for
any liability that these contractual assumptions directly impose on
those licensors and authors.
All other non-permissive additional terms are considered "further
restrictions" within the meaning of section 10. If the Program as you
received it, or any part of it, contains a notice stating that it is
governed by this License along with a term that is a further
restriction, you may remove that term. If a license document contains
a further restriction but permits relicensing or conveying under this
License, you may add to a covered work material governed by the terms
of that license document, provided that the further restriction does
not survive such relicensing or conveying.
If you add terms to a covered work in accord with this section, you
must place, in the relevant source files, a statement of the
additional terms that apply to those files, or a notice indicating
where to find the applicable terms.
Additional terms, permissive or non-permissive, may be stated in the
form of a separately written license, or stated as exceptions;
the above requirements apply either way.
8. Termination.
You may not propagate or modify a covered work except as expressly
provided under this License. Any attempt otherwise to propagate or
modify it is void, and will automatically terminate your rights under
this License (including any patent licenses granted under the third
paragraph of section 11).
However, if you cease all violation of this License, then your
license from a particular copyright holder is reinstated (a)
provisionally, unless and until the copyright holder explicitly and
finally terminates your license, and (b) permanently, if the copyright
holder fails to notify you of the violation by some reasonable means
prior to 60 days after the cessation.
Moreover, your license from a particular copyright holder is
reinstated permanently if the copyright holder notifies you of the
violation by some reasonable means, this is the first time you have
received notice of violation of this License (for any work) from that
copyright holder, and you cure the violation prior to 30 days after
your receipt of the notice.
Termination of your rights under this section does not terminate the
licenses of parties who have received copies or rights from you under
this License. If your rights have been terminated and not permanently
reinstated, you do not qualify to receive new licenses for the same
material under section 10.
9. Acceptance Not Required for Having Copies.
You are not required to accept this License in order to receive or
run a copy of the Program. Ancillary propagation of a covered work
occurring solely as a consequence of using peer-to-peer transmission
to receive a copy likewise does not require acceptance. However,
nothing other than this License grants you permission to propagate or
modify any covered work. These actions infringe copyright if you do
not accept this License. Therefore, by modifying or propagating a
covered work, you indicate your acceptance of this License to do so.
10. Automatic Licensing of Downstream Recipients.
Each time you convey a covered work, the recipient automatically
receives a license from the original licensors, to run, modify and
propagate that work, subject to this License. You are not responsible
for enforcing compliance by third parties with this License.
An "entity transaction" is a transaction transferring control of an
organization, or substantially all assets of one, or subdividing an
organization, or merging organizations. If propagation of a covered
work results from an entity transaction, each party to that
transaction who receives a copy of the work also receives whatever
licenses to the work the party's predecessor in interest had or could
give under the previous paragraph, plus a right to possession of the
Corresponding Source of the work from the predecessor in interest, if
the predecessor has it or can get it with reasonable efforts.
You may not impose any further restrictions on the exercise of the
rights granted or affirmed under this License. For example, you may
not impose a license fee, royalty, or other charge for exercise of
rights granted under this License, and you may not initiate litigation
(including a cross-claim or counterclaim in a lawsuit) alleging that
any patent claim is infringed by making, using, selling, offering for
sale, or importing the Program or any portion of it.
11. Patents.
A "contributor" is a copyright holder who authorizes use under this
License of the Program or a work on which the Program is based. The
work thus licensed is called the contributor's "contributor version".
A contributor's "essential patent claims" are all patent claims
owned or controlled by the contributor, whether already acquired or
hereafter acquired, that would be infringed by some manner, permitted
by this License, of making, using, or selling its contributor version,
but do not include claims that would be infringed only as a
consequence of further modification of the contributor version. For
purposes of this definition, "control" includes the right to grant
patent sublicenses in a manner consistent with the requirements of
this License.
Each contributor grants you a non-exclusive, worldwide, royalty-free
patent license under the contributor's essential patent claims, to
make, use, sell, offer for sale, import and otherwise run, modify and
propagate the contents of its contributor version.
In the following three paragraphs, a "patent license" is any express
agreement or commitment, however denominated, not to enforce a patent
(such as an express permission to practice a patent or covenant not to
sue for patent infringement). To "grant" such a patent license to a
party means to make such an agreement or commitment not to enforce a
patent against the party.
If you convey a covered work, knowingly relying on a patent license,
and the Corresponding Source of the work is not available for anyone
to copy, free of charge and under the terms of this License, through a
publicly available network server or other readily accessible means,
then you must either (1) cause the Corresponding Source to be so
available, or (2) arrange to deprive yourself of the benefit of the
patent license for this particular work, or (3) arrange, in a manner
consistent with the requirements of this License, to extend the patent
license to downstream recipients. "Knowingly relying" means you have
actual knowledge that, but for the patent license, your conveying the
covered work in a country, or your recipient's use of the covered work
in a country, would infringe one or more identifiable patents in that
country that you have reason to believe are valid.
If, pursuant to or in connection with a single transaction or
arrangement, you convey, or propagate by procuring conveyance of, a
covered work, and grant a patent license to some of the parties
receiving the covered work authorizing them to use, propagate, modify
or convey a specific copy of the covered work, then the patent license
you grant is automatically extended to all recipients of the covered
work and works based on it.
A patent license is "discriminatory" if it does not include within
the scope of its coverage, prohibits the exercise of, or is
conditioned on the non-exercise of one or more of the rights that are
specifically granted under this License. You may not convey a covered
work if you are a party to an arrangement with a third party that is
in the business of distributing software, under which you make payment
to the third party based on the extent of your activity of conveying
the work, and under which the third party grants, to any of the
parties who would receive the covered work from you, a discriminatory
patent license (a) in connection with copies of the covered work
conveyed by you (or copies made from those copies), or (b) primarily
for and in connection with specific products or compilations that
contain the covered work, unless you entered into that arrangement,
or that patent license was granted, prior to 28 March 2007.
Nothing in this License shall be construed as excluding or limiting
any implied license or other defenses to infringement that may
otherwise be available to you under applicable patent law.
12. No Surrender of Others' Freedom.
If conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot convey a
covered work so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you may
not convey it at all. For example, if you agree to terms that obligate you
to collect a royalty for further conveying from those to whom you convey
the Program, the only way you could satisfy both those terms and this
License would be to refrain entirely from conveying the Program.
13. Use with the GNU Affero General Public License.
Notwithstanding any other provision of this License, you have
permission to link or combine any covered work with a work licensed
under version 3 of the GNU Affero General Public License into a single
combined work, and to convey the resulting work. The terms of this
License will continue to apply to the part which is the covered work,
but the special requirements of the GNU Affero General Public License,
section 13, concerning interaction through a network will apply to the
combination as such.
14. Revised Versions of this License.
The Free Software Foundation may publish revised and/or new versions of
the GNU General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the
Program specifies that a certain numbered version of the GNU General
Public License "or any later version" applies to it, you have the
option of following the terms and conditions either of that numbered
version or of any later version published by the Free Software
Foundation. If the Program does not specify a version number of the
GNU General Public License, you may choose any version ever published
by the Free Software Foundation.
If the Program specifies that a proxy can decide which future
versions of the GNU General Public License can be used, that proxy's
public statement of acceptance of a version permanently authorizes you
to choose that version for the Program.
Later license versions may give you additional or different
permissions. However, no additional obligations are imposed on any
author or copyright holder as a result of your choosing to follow a
later version.
15. Disclaimer of Warranty.
THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
16. Limitation of Liability.
IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
SUCH DAMAGES.
17. Interpretation of Sections 15 and 16.
If the disclaimer of warranty and limitation of liability provided
above cannot be given local legal effect according to their terms,
reviewing courts shall apply local law that most closely approximates
an absolute waiver of all civil liability in connection with the
Program, unless a warranty or assumption of liability accompanies a
copy of the Program in return for a fee.
END OF TERMS AND CONDITIONS
How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.
To do so, attach the following notices to the program. It is safest
to attach them to the start of each source file to most effectively
state the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) <year> <name of author>
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
Also add information on how to contact you by electronic and paper mail.
If the program does terminal interaction, make it output a short
notice like this when it starts in an interactive mode:
<program> Copyright (C) <year> <name of author>
This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the appropriate
parts of the General Public License. Of course, your program's commands
might be different; for a GUI interface, you would use an "about box".
You should also get your employer (if you work as a programmer) or school,
if any, to sign a "copyright disclaimer" for the program, if necessary.
For more information on this, and how to apply and follow the GNU GPL, see
<https://www.gnu.org/licenses/>.
The GNU General Public License does not permit incorporating your program
into proprietary programs. If your program is a subroutine library, you
may consider it more useful to permit linking proprietary applications with
the library. If this is what you want to do, use the GNU Lesser General
Public License instead of this License. But first, please read
<https://www.gnu.org/licenses/why-not-lgpl.html>.

18
code/elpa/magit-20220425.1153/dir Normal file
View file

@ -0,0 +1,18 @@
This is the file .../info/dir, which contains the
topmost node of the Info hierarchy, called (dir)Top.
The first time you invoke Info you start off looking at this node.

File: dir, Node: Top This is the top of the INFO tree
This (the Directory node) gives a menu of major topics.
Typing "q" exits, "H" lists all Info commands, "d" returns here,
"h" gives a primer for first-timers,
"mEmacs<Return>" visits the Emacs manual, etc.
In Emacs, you can click mouse button 2 on a menu item or cross reference
to select it.
* Menu:
Emacs
* Magit: (magit). Using Git from Emacs with Magit.

848
code/elpa/magit-20220425.1153/git-rebase.el Normal file
View file

@ -0,0 +1,848 @@
;;; git-rebase.el --- Edit Git rebase files -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Phil Jackson <phil@shellarchive.co.uk>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This package assists the user in editing the list of commits to be
;; rewritten during an interactive rebase.
;; When the user initiates an interactive rebase, e.g. using "r e" in
;; a Magit buffer or on the command line using "git rebase -i REV",
;; Git invokes the `$GIT_SEQUENCE_EDITOR' (or if that is undefined
;; `$GIT_EDITOR' or even `$EDITOR') letting the user rearrange, drop,
;; reword, edit, and squash commits.
;; This package provides the major-mode `git-rebase-mode' which makes
;; doing so much more fun, by making the buffer more colorful and
;; providing the following commands:
;;
;; C-c C-c Tell Git to make it happen.
;; C-c C-k Tell Git that you changed your mind, i.e. abort.
;;
;; p Move point to previous line.
;; n Move point to next line.
;;
;; M-p Move the commit at point up.
;; M-n Move the commit at point down.
;;
;; k Drop the commit at point.
;; c Don't drop the commit at point.
;; r Change the message of the commit at point.
;; e Edit the commit at point.
;; s Squash the commit at point, into the one above.
;; f Like "s" but don't also edit the commit message.
;; b Break for editing at this point in the sequence.
;; x Add a script to be run with the commit at point
;; being checked out.
;; z Add noop action at point.
;;
;; SPC Show the commit at point in another buffer.
;; RET Show the commit at point in another buffer and
;; select its window.
;; C-/ Undo last change.
;;
;; Commands for --rebase-merges:
;; l Associate label with current HEAD in sequence.
;; MM Merge specified revisions into HEAD.
;; Mt Toggle whether the merge will invoke an editor
;; before committing.
;; t Reset HEAD to the specified label.
;; You should probably also read the `git-rebase' manpage.
;;; Code:
(require 'magit)
(require 'easymenu)
(require 'server)
(require 'with-editor)
(defvar recentf-exclude)
;;; Options
;;;; Variables
(defgroup git-rebase nil
"Edit Git rebase sequences."
:link '(info-link "(magit)Editing Rebase Sequences")
:group 'tools)
(defcustom git-rebase-auto-advance t
"Whether to move to next line after changing a line."
:group 'git-rebase
:type 'boolean)
(defcustom git-rebase-show-instructions t
"Whether to show usage instructions inside the rebase buffer."
:group 'git-rebase
:type 'boolean)
(defcustom git-rebase-confirm-cancel t
"Whether confirmation is required to cancel."
:group 'git-rebase
:type 'boolean)
;;;; Faces
(defgroup git-rebase-faces nil
"Faces used by Git-Rebase mode."
:group 'faces
:group 'git-rebase)
(defface git-rebase-hash '((t :inherit magit-hash))
"Face for commit hashes."
:group 'git-rebase-faces)
(defface git-rebase-label '((t :inherit magit-refname))
"Face for labels in label, merge, and reset lines."
:group 'git-rebase-faces)
(defface git-rebase-description '((t nil))
"Face for commit descriptions."
:group 'git-rebase-faces)
(defface git-rebase-action
'((t :inherit font-lock-keyword-face))
"Face for action keywords."
:group 'git-rebase-faces)
(defface git-rebase-killed-action
'((t :inherit font-lock-comment-face :strike-through t))
"Face for commented commit action lines."
:group 'git-rebase-faces)
(defface git-rebase-comment-hash
'((t :inherit git-rebase-hash :weight bold))
"Face for commit hashes in commit message comments."
:group 'git-rebase-faces)
(defface git-rebase-comment-heading
'((t :inherit font-lock-keyword-face))
"Face for headings in rebase message comments."
:group 'git-rebase-faces)
;;; Keymaps
(defvar git-rebase-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map special-mode-map)
(define-key map (kbd "C-m") #'git-rebase-show-commit)
(define-key map (kbd "p") #'git-rebase-backward-line)
(define-key map (kbd "n") #'forward-line)
(define-key map (kbd "M-p") #'git-rebase-move-line-up)
(define-key map (kbd "M-n") #'git-rebase-move-line-down)
(define-key map (kbd "c") #'git-rebase-pick)
(define-key map (kbd "k") #'git-rebase-kill-line)
(define-key map (kbd "C-k") #'git-rebase-kill-line)
(define-key map (kbd "b") #'git-rebase-break)
(define-key map (kbd "e") #'git-rebase-edit)
(define-key map (kbd "l") #'git-rebase-label)
(define-key map (kbd "MM") #'git-rebase-merge)
(define-key map (kbd "Mt") #'git-rebase-merge-toggle-editmsg)
(define-key map (kbd "m") #'git-rebase-edit)
(define-key map (kbd "f") #'git-rebase-fixup)
(define-key map (kbd "q") #'undefined)
(define-key map (kbd "r") #'git-rebase-reword)
(define-key map (kbd "w") #'git-rebase-reword)
(define-key map (kbd "s") #'git-rebase-squash)
(define-key map (kbd "t") #'git-rebase-reset)
(define-key map (kbd "x") #'git-rebase-exec)
(define-key map (kbd "y") #'git-rebase-insert)
(define-key map (kbd "z") #'git-rebase-noop)
(define-key map (kbd "SPC") #'git-rebase-show-or-scroll-up)
(define-key map (kbd "DEL") #'git-rebase-show-or-scroll-down)
(define-key map (kbd "C-x C-t") #'git-rebase-move-line-up)
(define-key map [M-up] #'git-rebase-move-line-up)
(define-key map [M-down] #'git-rebase-move-line-down)
(define-key map [remap undo] #'git-rebase-undo)
map)
"Keymap for Git-Rebase mode.")
(put 'git-rebase-reword :advertised-binding (kbd "r"))
(put 'git-rebase-move-line-up :advertised-binding (kbd "M-p"))
(put 'git-rebase-kill-line :advertised-binding (kbd "k"))
(easy-menu-define git-rebase-mode-menu git-rebase-mode-map
"Git-Rebase mode menu"
'("Rebase"
["Pick" git-rebase-pick t]
["Reword" git-rebase-reword t]
["Edit" git-rebase-edit t]
["Squash" git-rebase-squash t]
["Fixup" git-rebase-fixup t]
["Kill" git-rebase-kill-line t]
["Noop" git-rebase-noop t]
["Execute" git-rebase-exec t]
["Move Down" git-rebase-move-line-down t]
["Move Up" git-rebase-move-line-up t]
"---"
["Cancel" with-editor-cancel t]
["Finish" with-editor-finish t]))
(defvar git-rebase-command-descriptions
'((with-editor-finish . "tell Git to make it happen")
(with-editor-cancel . "tell Git that you changed your mind, i.e. abort")
(git-rebase-backward-line . "move point to previous line")
(forward-line . "move point to next line")
(git-rebase-move-line-up . "move the commit at point up")
(git-rebase-move-line-down . "move the commit at point down")
(git-rebase-show-or-scroll-up . "show the commit at point in another buffer")
(git-rebase-show-commit
. "show the commit at point in another buffer and select its window")
(undo . "undo last change")
(git-rebase-kill-line . "drop the commit at point")
(git-rebase-insert . "insert a line for an arbitrary commit")
(git-rebase-noop . "add noop action at point")))
;;; Commands
(defun git-rebase-pick ()
"Use commit on current line.
If the region is active, act on all lines touched by the region."
(interactive)
(git-rebase-set-action "pick"))
(defun git-rebase-reword ()
"Edit message of commit on current line.
If the region is active, act on all lines touched by the region."
(interactive)
(git-rebase-set-action "reword"))
(defun git-rebase-edit ()
"Stop at the commit on the current line.
If the region is active, act on all lines touched by the region."
(interactive)
(git-rebase-set-action "edit"))
(defun git-rebase-squash ()
"Meld commit on current line into previous commit, edit message.
If the region is active, act on all lines touched by the region."
(interactive)
(git-rebase-set-action "squash"))
(defun git-rebase-fixup ()
"Meld commit on current line into previous commit, discard its message.
If the region is active, act on all lines touched by the region."
(interactive)
(git-rebase-set-action "fixup"))
(defvar-local git-rebase-comment-re nil)
(defvar git-rebase-short-options
'((?b . "break")
(?e . "edit")
(?f . "fixup")
(?l . "label")
(?m . "merge")
(?p . "pick")
(?r . "reword")
(?s . "squash")
(?t . "reset")
(?x . "exec"))
"Alist mapping single key of an action to the full name.")
(defclass git-rebase-action ()
(;; action-type: commit, exec, bare, label, merge
(action-type :initarg :action-type :initform nil)
;; Examples for each action type:
;; | action | action options | target | trailer |
;; |--------+----------------+---------+---------|
;; | pick | | hash | subject |
;; | exec | | command | |
;; | noop | | | |
;; | reset | | name | subject |
;; | merge | -C hash | name | subject |
(action :initarg :action :initform nil)
(action-options :initarg :action-options :initform nil)
(target :initarg :target :initform nil)
(trailer :initarg :trailer :initform nil)
(comment-p :initarg :comment-p :initform nil)))
(defvar git-rebase-line-regexps
`((commit . ,(concat
(regexp-opt '("e" "edit"
"f" "fixup"
"p" "pick"
"r" "reword"
"s" "squash")
"\\(?1:")
" \\(?3:[^ \n]+\\) ?\\(?4:.*\\)"))
(exec . "\\(?1:x\\|exec\\) \\(?3:.*\\)")
(bare . ,(concat (regexp-opt '("b" "break" "noop") "\\(?1:")
" *$"))
(label . ,(concat (regexp-opt '("l" "label"
"t" "reset")
"\\(?1:")
" \\(?3:[^ \n]+\\) ?\\(?4:.*\\)"))
(merge . ,(concat "\\(?1:m\\|merge\\) "
"\\(?:\\(?2:-[cC] [^ \n]+\\) \\)?"
"\\(?3:[^ \n]+\\)"
" ?\\(?4:.*\\)"))))
;;;###autoload
(defun git-rebase-current-line ()
"Parse current line into a `git-rebase-action' instance.
If the current line isn't recognized as a rebase line, an
instance with all nil values is returned."
(save-excursion
(goto-char (line-beginning-position))
(if-let ((re-start (concat "^\\(?5:" (regexp-quote comment-start)
"\\)? *"))
(type (seq-some (lambda (arg)
(let ((case-fold-search nil))
(and (looking-at (concat re-start (cdr arg)))
(car arg))))
git-rebase-line-regexps)))
(git-rebase-action
:action-type type
:action (and-let* ((action (match-string-no-properties 1)))
(or (cdr (assoc action git-rebase-short-options))
action))
:action-options (match-string-no-properties 2)
:target (match-string-no-properties 3)
:trailer (match-string-no-properties 4)
:comment-p (and (match-string 5) t))
;; Use default empty class rather than nil to ease handling.
(git-rebase-action))))
(defun git-rebase-set-action (action)
"Set action of commit line to ACTION.
If the region is active, operate on all lines that it touches.
Otherwise, operate on the current line. As a special case, an
ACTION of nil comments the rebase line, regardless of its action
type."
(pcase (git-rebase-region-bounds t)
(`(,beg ,end)
(let ((end-marker (copy-marker end))
(pt-below-p (and mark-active (< (mark) (point)))))
(set-marker-insertion-type end-marker t)
(goto-char beg)
(while (< (point) end-marker)
(with-slots (action-type target trailer comment-p)
(git-rebase-current-line)
(cond
((and action (eq action-type 'commit))
(let ((inhibit-read-only t))
(magit-delete-line)
(insert (concat action " " target " " trailer "\n"))))
((and action-type (not (or action comment-p)))
(let ((inhibit-read-only t))
(insert comment-start " "))
(forward-line))
(t
;; In the case of --rebase-merges, commit lines may have
;; other lines with other action types, empty lines, and
;; "Branch" comments interspersed. Move along.
(forward-line)))))
(goto-char
(if git-rebase-auto-advance
end-marker
(if pt-below-p (1- end-marker) beg)))
(goto-char (line-beginning-position))))
(_ (ding))))
(defun git-rebase-line-p (&optional pos)
(save-excursion
(when pos (goto-char pos))
(and (oref (git-rebase-current-line) action-type)
t)))
(defun git-rebase-region-bounds (&optional fallback)
"Return region bounds if both ends touch rebase lines.
Each bound is extended to include the entire line touched by the
point or mark. If the region isn't active and FALLBACK is
non-nil, return the beginning and end of the current rebase line,
if any."
(cond
((use-region-p)
(let ((beg (save-excursion (goto-char (region-beginning))
(line-beginning-position)))
(end (save-excursion (goto-char (region-end))
(line-end-position))))
(when (and (git-rebase-line-p beg)
(git-rebase-line-p end))
(list beg (1+ end)))))
((and fallback (git-rebase-line-p))
(list (line-beginning-position)
(1+ (line-end-position))))))
(defun git-rebase-move-line-down (n)
"Move the current commit (or command) N lines down.
If N is negative, move the commit up instead. With an active
region, move all the lines that the region touches, not just the
current line."
(interactive "p")
(pcase-let* ((`(,beg ,end)
(or (git-rebase-region-bounds)
(list (line-beginning-position)
(1+ (line-end-position)))))
(pt-offset (- (point) beg))
(mark-offset (and mark-active (- (mark) beg))))
(save-restriction
(narrow-to-region
(point-min)
(1-
(if git-rebase-show-instructions
(save-excursion
(goto-char (point-min))
(while (or (git-rebase-line-p)
;; The output for --rebase-merges has empty
;; lines and "Branch" comments interspersed.
(looking-at-p "^$")
(looking-at-p (concat git-rebase-comment-re
" Branch")))
(forward-line))
(line-beginning-position))
(point-max))))
(if (or (and (< n 0) (= beg (point-min)))
(and (> n 0) (= end (point-max)))
(> end (point-max)))
(ding)
(goto-char (if (< n 0) beg end))
(forward-line n)
(atomic-change-group
(let ((inhibit-read-only t))
(insert (delete-and-extract-region beg end)))
(let ((new-beg (- (point) (- end beg))))
(when (use-region-p)
(setq deactivate-mark nil)
(set-mark (+ new-beg mark-offset)))
(goto-char (+ new-beg pt-offset))))))))
(defun git-rebase-move-line-up (n)
"Move the current commit (or command) N lines up.
If N is negative, move the commit down instead. With an active
region, move all the lines that the region touches, not just the
current line."
(interactive "p")
(git-rebase-move-line-down (- n)))
(defun git-rebase-highlight-region (start end window rol)
(let ((inhibit-read-only t)
(deactivate-mark nil)
(bounds (git-rebase-region-bounds)))
(mapc #'delete-overlay magit-section-highlight-overlays)
(when bounds
(magit-section-make-overlay (car bounds) (cadr bounds)
'magit-section-heading-selection))
(if (and bounds (not magit-section-keep-region-overlay))
(funcall (default-value 'redisplay-unhighlight-region-function) rol)
(funcall (default-value 'redisplay-highlight-region-function)
start end window rol))))
(defun git-rebase-unhighlight-region (rol)
(mapc #'delete-overlay magit-section-highlight-overlays)
(funcall (default-value 'redisplay-unhighlight-region-function) rol))
(defun git-rebase-kill-line ()
"Kill the current action line.
If the region is active, act on all lines touched by the region."
(interactive)
(git-rebase-set-action nil))
(defun git-rebase-insert (rev)
"Read an arbitrary commit and insert it below current line."
(interactive (list (magit-read-branch-or-commit "Insert revision")))
(forward-line)
(--if-let (magit-rev-format "%h %s" rev)
(let ((inhibit-read-only t))
(insert "pick " it ?\n))
(user-error "Unknown revision")))
(defun git-rebase-set-noncommit-action (action value-fn arg)
(goto-char (line-beginning-position))
(pcase-let* ((inhibit-read-only t)
(`(,initial ,trailer ,comment-p)
(and (not arg)
(with-slots ((ln-action action)
target trailer comment-p)
(git-rebase-current-line)
(and (equal ln-action action)
(list target trailer comment-p)))))
(value (funcall value-fn initial)))
(pcase (list value initial comment-p)
(`("" nil ,_)
(ding))
(`("" ,_ ,_)
(magit-delete-line))
(_
(if initial
(magit-delete-line)
(forward-line))
(insert (concat action " " value
(and (equal value initial)
trailer
(concat " " trailer))
"\n"))
(unless git-rebase-auto-advance
(forward-line -1))))))
(defun git-rebase-exec (arg)
"Insert a shell command to be run after the current commit.
If there already is such a command on the current line, then edit
that instead. With a prefix argument insert a new command even
when there already is one on the current line. With empty input
remove the command on the current line, if any."
(interactive "P")
(git-rebase-set-noncommit-action
"exec"
(lambda (initial) (read-shell-command "Execute: " initial))
arg))
(defun git-rebase-label (arg)
"Add a label after the current commit.
If there already is a label on the current line, then edit that
instead. With a prefix argument, insert a new label even when
there is already a label on the current line. With empty input,
remove the label on the current line, if any."
(interactive "P")
(git-rebase-set-noncommit-action
"label"
(lambda (initial)
(read-from-minibuffer
"Label: " initial magit-minibuffer-local-ns-map))
arg))
(defun git-rebase-buffer-labels ()
(let (labels)
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^\\(?:l\\|label\\) \\([^ \n]+\\)" nil t)
(push (match-string-no-properties 1) labels)))
(nreverse labels)))
(defun git-rebase-reset (arg)
"Reset the current HEAD to a label.
If there already is a reset command on the current line, then
edit that instead. With a prefix argument, insert a new reset
line even when point is already on a reset line. With empty
input, remove the reset command on the current line, if any."
(interactive "P")
(git-rebase-set-noncommit-action
"reset"
(lambda (initial)
(or (magit-completing-read "Label" (git-rebase-buffer-labels)
nil t initial)
""))
arg))
(defun git-rebase-merge (arg)
"Add a merge command after the current commit.
If there is already a merge command on the current line, then
replace that command instead. With a prefix argument, insert a
new merge command even when there is already one on the current
line. With empty input, remove the merge command on the current
line, if any."
(interactive "P")
(git-rebase-set-noncommit-action
"merge"
(lambda (_)
(or (magit-completing-read "Merge" (git-rebase-buffer-labels))
""))
arg))
(defun git-rebase-merge-toggle-editmsg ()
"Toggle whether an editor is invoked when performing the merge at point.
When a merge command uses a lower-case -c, the message for the
specified commit will be opened in an editor before creating the
commit. For an upper-case -C, the message will be used as is."
(interactive)
(with-slots (action-type target action-options trailer)
(git-rebase-current-line)
(if (eq action-type 'merge)
(let ((inhibit-read-only t))
(magit-delete-line)
(insert
(format "merge %s %s %s\n"
(replace-regexp-in-string
"-[cC]" (lambda (c)
(if (equal c "-c") "-C" "-c"))
action-options t t)
target
trailer)))
(ding))))
(defun git-rebase-set-bare-action (action arg)
(goto-char (line-beginning-position))
(with-slots ((ln-action action) comment-p)
(git-rebase-current-line)
(let ((same-action-p (equal action ln-action))
(inhibit-read-only t))
(when (or arg
(not ln-action)
(not same-action-p)
(and same-action-p comment-p))
(unless (or arg (not same-action-p))
(magit-delete-line))
(insert action ?\n)
(unless git-rebase-auto-advance
(forward-line -1))))))
(defun git-rebase-noop (&optional arg)
"Add noop action at point.
If the current line already contains a noop action, leave it
unchanged. If there is a commented noop action present, remove
the comment. Otherwise add a new noop action. With a prefix
argument insert a new noop action regardless of what is already
present on the current line.
A noop action can be used to make git perform a rebase even if
no commits are selected. Without the noop action present, git
would see an empty file and therefore do nothing."
(interactive "P")
(git-rebase-set-bare-action "noop" arg))
(defun git-rebase-break (&optional arg)
"Add break action at point.
If there is a commented break action present, remove the comment.
If the current line already contains a break action, add another
break action only if a prefix argument is given.
A break action can be used to interrupt the rebase at the
specified point. It is particularly useful for pausing before
the first commit in the sequence. For other cases, the
equivalent behavior can be achieved with `git-rebase-edit'."
(interactive "P")
(git-rebase-set-bare-action "break" arg))
(defun git-rebase-undo (&optional arg)
"Undo some previous changes.
Like `undo' but works in read-only buffers."
(interactive "P")
(let ((inhibit-read-only t))
(undo arg)))
(defun git-rebase--show-commit (&optional scroll)
(let ((disable-magit-save-buffers t))
(save-excursion
(goto-char (line-beginning-position))
(--if-let (with-slots (action-type target) (git-rebase-current-line)
(and (eq action-type 'commit)
target))
(pcase scroll
('up (magit-diff-show-or-scroll-up))
('down (magit-diff-show-or-scroll-down))
(_ (apply #'magit-show-commit it
(magit-diff-arguments 'magit-revision-mode))))
(ding)))))
(defun git-rebase-show-commit ()
"Show the commit on the current line if any."
(interactive)
(git-rebase--show-commit))
(defun git-rebase-show-or-scroll-up ()
"Update the commit buffer for commit on current line.
Either show the commit at point in the appropriate buffer, or if
that buffer is already being displayed in the current frame and
contains information about that commit, then instead scroll the
buffer up."
(interactive)
(git-rebase--show-commit 'up))
(defun git-rebase-show-or-scroll-down ()
"Update the commit buffer for commit on current line.
Either show the commit at point in the appropriate buffer, or if
that buffer is already being displayed in the current frame and
contains information about that commit, then instead scroll the
buffer down."
(interactive)
(git-rebase--show-commit 'down))
(defun git-rebase-backward-line (&optional n)
"Move N lines backward (forward if N is negative).
Like `forward-line' but go into the opposite direction."
(interactive "p")
(forward-line (- (or n 1))))
;;; Mode
;;;###autoload
(define-derived-mode git-rebase-mode special-mode "Git Rebase"
"Major mode for editing of a Git rebase file.
Rebase files are generated when you run 'git rebase -i' or run
`magit-interactive-rebase'. They describe how Git should perform
the rebase. See the documentation for git-rebase (e.g., by
running 'man git-rebase' at the command line) for details."
:group 'git-rebase
(setq comment-start (or (magit-get "core.commentChar") "#"))
(setq git-rebase-comment-re (concat "^" (regexp-quote comment-start)))
(setq font-lock-defaults (list (git-rebase-mode-font-lock-keywords) t t))
(unless git-rebase-show-instructions
(let ((inhibit-read-only t))
(flush-lines git-rebase-comment-re)))
(unless with-editor-mode
;; Maybe already enabled when using `shell-command' or an Emacs shell.
(with-editor-mode 1))
(when git-rebase-confirm-cancel
(add-hook 'with-editor-cancel-query-functions
#'git-rebase-cancel-confirm nil t))
(setq-local redisplay-highlight-region-function #'git-rebase-highlight-region)
(setq-local redisplay-unhighlight-region-function #'git-rebase-unhighlight-region)
(add-hook 'with-editor-pre-cancel-hook #'git-rebase-autostash-save nil t)
(add-hook 'with-editor-post-cancel-hook #'git-rebase-autostash-apply nil t)
(setq imenu-prev-index-position-function
#'magit-imenu--rebase-prev-index-position-function)
(setq imenu-extract-index-name-function
#'magit-imenu--rebase-extract-index-name-function)
(when (boundp 'save-place)
(setq save-place nil)))
(defun git-rebase-cancel-confirm (force)
(or (not (buffer-modified-p))
force
(magit-confirm 'abort-rebase "Abort this rebase" nil 'noabort)))
(defun git-rebase-autostash-save ()
(--when-let (magit-file-line (magit-git-dir "rebase-merge/autostash"))
(push (cons 'stash it) with-editor-cancel-alist)))
(defun git-rebase-autostash-apply ()
(--when-let (cdr (assq 'stash with-editor-cancel-alist))
(magit-stash-apply it)))
(defun git-rebase-match-comment-line (limit)
(re-search-forward (concat git-rebase-comment-re ".*") limit t))
(defun git-rebase-mode-font-lock-keywords ()
"Font lock keywords for Git-Rebase mode."
`((,(concat "^" (cdr (assq 'commit git-rebase-line-regexps)))
(1 'git-rebase-action)
(3 'git-rebase-hash)
(4 'git-rebase-description))
(,(concat "^" (cdr (assq 'exec git-rebase-line-regexps)))
(1 'git-rebase-action)
(3 'git-rebase-description))
(,(concat "^" (cdr (assq 'bare git-rebase-line-regexps)))
(1 'git-rebase-action))
(,(concat "^" (cdr (assq 'label git-rebase-line-regexps)))
(1 'git-rebase-action)
(3 'git-rebase-label)
(4 'font-lock-comment-face))
("^\\(m\\(?:erge\\)?\\) -[Cc] \\([^ \n]+\\) \\([^ \n]+\\)\\( #.*\\)?"
(1 'git-rebase-action)
(2 'git-rebase-hash)
(3 'git-rebase-label)
(4 'font-lock-comment-face))
("^\\(m\\(?:erge\\)?\\) \\([^ \n]+\\)"
(1 'git-rebase-action)
(2 'git-rebase-label))
(,(concat git-rebase-comment-re " *"
(cdr (assq 'commit git-rebase-line-regexps)))
0 'git-rebase-killed-action t)
(git-rebase-match-comment-line 0 'font-lock-comment-face)
("\\[[^[]*\\]"
0 'magit-keyword t)
("\\(?:fixup!\\|squash!\\)"
0 'magit-keyword-squash t)
(,(format "^%s Rebase \\([^ ]*\\) onto \\([^ ]*\\)" comment-start)
(1 'git-rebase-comment-hash t)
(2 'git-rebase-comment-hash t))
(,(format "^%s \\(Commands:\\)" comment-start)
(1 'git-rebase-comment-heading t))
(,(format "^%s Branch \\(.*\\)" comment-start)
(1 'git-rebase-label t))))
(defun git-rebase-mode-show-keybindings ()
"Modify the \"Commands:\" section of the comment Git generates
at the bottom of the file so that in place of the one-letter
abbreviation for the command, it shows the command's keybinding.
By default, this is the same except for the \"pick\" command."
(let ((inhibit-read-only t))
(save-excursion
(goto-char (point-min))
(when (and git-rebase-show-instructions
(re-search-forward
(concat git-rebase-comment-re "\\s-+p, pick")
nil t))
(goto-char (line-beginning-position))
(pcase-dolist (`(,cmd . ,desc) git-rebase-command-descriptions)
(insert (format "%s %-8s %s\n"
comment-start
(substitute-command-keys (format "\\[%s]" cmd))
desc)))
(while (re-search-forward (concat git-rebase-comment-re
"\\( ?\\)\\([^\n,],\\) "
"\\([^\n ]+\\) ")
nil t)
(let ((cmd (intern (concat "git-rebase-" (match-string 3)))))
(if (not (fboundp cmd))
(delete-region (line-beginning-position) (1+ (line-end-position)))
(replace-match " " t t nil 1)
(replace-match
(format "%-8s"
(mapconcat #'key-description
(--remove (eq (elt it 0) 'menu-bar)
(reverse (where-is-internal
cmd git-rebase-mode-map)))
", "))
t t nil 2))))))))
(add-hook 'git-rebase-mode-hook #'git-rebase-mode-show-keybindings t)
(defun git-rebase-mode-disable-before-save-hook ()
(set (make-local-variable 'before-save-hook) nil))
(add-hook 'git-rebase-mode-hook #'git-rebase-mode-disable-before-save-hook)
;;;###autoload
(defconst git-rebase-filename-regexp "/git-rebase-todo\\'")
;;;###autoload
(add-to-list 'auto-mode-alist
(cons git-rebase-filename-regexp #'git-rebase-mode))
(add-to-list 'with-editor-server-window-alist
(cons git-rebase-filename-regexp #'switch-to-buffer))
(with-eval-after-load 'recentf
(add-to-list 'recentf-exclude git-rebase-filename-regexp))
(add-to-list 'with-editor-file-name-history-exclude git-rebase-filename-regexp)
;;; Imenu Support
(defun magit-imenu--rebase-prev-index-position-function ()
"Move point to previous commit in git-rebase buffer.
Used as a value for `imenu-prev-index-position-function'."
(catch 'found
(while (not (bobp))
(git-rebase-backward-line)
(when (git-rebase-line-p)
(throw 'found t)))))
(defun magit-imenu--rebase-extract-index-name-function ()
"Return imenu name for line at point.
Point should be at the beginning of the line. This function
is used as a value for `imenu-extract-index-name-function'."
(buffer-substring-no-properties (line-beginning-position)
(line-end-position)))
;;; _
(provide 'git-rebase)
;;; git-rebase.el ends here

806
code/elpa/magit-20220425.1153/magit-apply.el Normal file
View file

@ -0,0 +1,806 @@
;;; magit-apply.el --- Apply Git diffs -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library implements commands for applying Git diffs or parts
;; of such a diff. The supported "apply variants" are apply, stage,
;; unstage, discard, and reverse - more than Git itself knows about,
;; at least at the porcelain level.
;;; Code:
(require 'magit-core)
(require 'magit-diff)
(require 'magit-wip)
(require 'transient) ; See #3732.
;; For `magit-apply'
(declare-function magit-am "magit-sequence" () t)
(declare-function magit-patch-apply "magit-patch" () t)
;; For `magit-discard-files'
(declare-function magit-checkout-stage "magit-merge" (file arg))
(declare-function magit-checkout-read-stage "magit-merge" (file))
(defvar auto-revert-verbose)
;; For `magit-stage-untracked'
(declare-function magit-submodule-add-1 "magit-submodule"
(url &optional path name args))
(declare-function magit-submodule-read-name-for-path "magit-submodule"
(path &optional prefer-short))
(declare-function borg--maybe-absorb-gitdir "borg" (pkg))
(declare-function borg--sort-submodule-sections "borg" (file))
(declare-function borg-assimilate "borg" (package url &optional partially))
(defvar borg-user-emacs-directory)
(cl-eval-when (compile load)
(when (< emacs-major-version 26)
(defalias 'smerge-keep-upper 'smerge-keep-mine)
(defalias 'smerge-keep-lower 'smerge-keep-other)))
;;; Options
(defcustom magit-delete-by-moving-to-trash t
"Whether Magit uses the system's trash can.
You should absolutely not disable this and also remove `discard'
from `magit-no-confirm'. You shouldn't do that even if you have
all of the Magit-Wip modes enabled, because those modes do not
track any files that are not tracked in the proper branch."
:package-version '(magit . "2.1.0")
:group 'magit-essentials
:type 'boolean)
(defcustom magit-unstage-committed t
"Whether unstaging a committed change reverts it instead.
A committed change cannot be unstaged, because staging and
unstaging are actions that are concerned with the differences
between the index and the working tree, not with committed
changes.
If this option is non-nil (the default), then typing \"u\"
\(`magit-unstage') on a committed change, causes it to be
reversed in the index but not the working tree. For more
information see command `magit-reverse-in-index'."
:package-version '(magit . "2.4.1")
:group 'magit-commands
:type 'boolean)
(defcustom magit-reverse-atomically nil
"Whether to reverse changes atomically.
If some changes can be reversed while others cannot, then nothing
is reversed if the value of this option is non-nil. But when it
is nil, then the changes that can be reversed are reversed and
for the other changes diff files are created that contain the
rejected reversals."
:package-version '(magit . "2.7.0")
:group 'magit-commands
:type 'boolean)
(defcustom magit-post-stage-hook nil
"Hook run after staging changes.
This hook is run by `magit-refresh' if `this-command'
is a member of `magit-post-stage-hook-commands'."
:package-version '(magit . "2.90.0")
:group 'magit-commands
:type 'hook)
(defvar magit-post-stage-hook-commands
'(magit-stage magit-stage-file magit-stage-modified))
(defcustom magit-post-unstage-hook nil
"Hook run after unstaging changes.
This hook is run by `magit-refresh' if `this-command'
is a member of `magit-post-unstage-hook-commands'."
:package-version '(magit . "2.90.0")
:group 'magit-commands
:type 'hook)
(defvar magit-post-unstage-hook-commands
'(magit-unstage magit-unstage-file magit-unstage-all))
;;; Commands
;;;; Apply
(defun magit-apply (&rest args)
"Apply the change at point to the working tree.
With a prefix argument fallback to a 3-way merge. Doing
so causes the change to be applied to the index as well."
(interactive (and current-prefix-arg (list "--3way")))
(--when-let (magit-apply--get-selection)
(pcase (list (magit-diff-type) (magit-diff-scope))
(`(,(or 'unstaged 'staged) ,_)
(user-error "Change is already in the working tree"))
(`(untracked ,(or 'file 'files))
(call-interactively #'magit-am))
(`(,_ region) (magit-apply-region it args))
(`(,_ hunk) (magit-apply-hunk it args))
(`(,_ hunks) (magit-apply-hunks it args))
(`(rebase-sequence file)
(call-interactively #'magit-patch-apply))
(`(,_ file) (magit-apply-diff it args))
(`(,_ files) (magit-apply-diffs it args)))))
(defun magit-apply--section-content (section)
(buffer-substring-no-properties (if (magit-hunk-section-p section)
(oref section start)
(oref section content))
(oref section end)))
(defun magit-apply-diffs (sections &rest args)
(setq sections (magit-apply--get-diffs sections))
(magit-apply-patch sections args
(mapconcat
(lambda (s)
(concat (magit-diff-file-header s)
(magit-apply--section-content s)))
sections "")))
(defun magit-apply-diff (section &rest args)
(setq section (car (magit-apply--get-diffs (list section))))
(magit-apply-patch section args
(concat (magit-diff-file-header section)
(magit-apply--section-content section))))
(defun magit-apply--adjust-hunk-new-starts (hunks)
"Adjust new line numbers in headers of HUNKS for partial application.
HUNKS should be a list of ordered, contiguous hunks to be applied
from a file. For example, if there is a sequence of hunks with
the headers
@@ -2,6 +2,7 @@
@@ -10,6 +11,7 @@
@@ -18,6 +20,7 @@
and only the second and third are to be applied, they would be
adjusted as \"@@ -10,6 +10,7 @@\" and \"@@ -18,6 +19,7 @@\"."
(let* ((first-hunk (car hunks))
(offset (if (string-match diff-hunk-header-re-unified first-hunk)
(- (string-to-number (match-string 3 first-hunk))
(string-to-number (match-string 1 first-hunk)))
(error "Header hunks have to be applied individually"))))
(if (= offset 0)
hunks
(mapcar (lambda (hunk)
(if (string-match diff-hunk-header-re-unified hunk)
(replace-match (number-to-string
(- (string-to-number (match-string 3 hunk))
offset))
t t hunk 3)
(error "Hunk does not have expected header")))
hunks))))
(defun magit-apply--adjust-hunk-new-start (hunk)
(car (magit-apply--adjust-hunk-new-starts (list hunk))))
(defun magit-apply-hunks (sections &rest args)
(let ((section (oref (car sections) parent)))
(when (string-match "^diff --cc" (oref section value))
(user-error "Cannot un-/stage resolution hunks. Stage the whole file"))
(magit-apply-patch
section args
(concat (oref section header)
(mapconcat #'identity
(magit-apply--adjust-hunk-new-starts
(mapcar #'magit-apply--section-content sections))
"")))))
(defun magit-apply-hunk (section &rest args)
(when (string-match "^diff --cc" (magit-section-parent-value section))
(user-error "Cannot un-/stage resolution hunks. Stage the whole file"))
(let* ((header (car (oref section value)))
(header (and (symbolp header) header))
(content (magit-apply--section-content section)))
(magit-apply-patch
(oref section parent) args
(concat (magit-diff-file-header section (not (eq header 'rename)))
(if header
content
(magit-apply--adjust-hunk-new-start content))))))
(defun magit-apply-region (section &rest args)
(when (string-match "^diff --cc" (magit-section-parent-value section))
(user-error "Cannot un-/stage resolution hunks. Stage the whole file"))
(magit-apply-patch (oref section parent) args
(concat (magit-diff-file-header section)
(magit-apply--adjust-hunk-new-start
(magit-diff-hunk-region-patch section args)))))
(defun magit-apply-patch (section:s args patch)
(let* ((files (if (atom section:s)
(list (oref section:s value))
(--map (oref it value) section:s)))
(command (symbol-name this-command))
(command (if (and command (string-match "^magit-\\([^-]+\\)" command))
(match-string 1 command)
"apply"))
(ignore-context (magit-diff-ignore-any-space-p)))
(unless (magit-diff-context-p)
(user-error "Not enough context to apply patch. Increase the context"))
(when (and magit-wip-before-change-mode (not magit-inhibit-refresh))
(magit-wip-commit-before-change files (concat " before " command)))
(with-temp-buffer
(insert patch)
(magit-run-git-with-input
"apply" args "-p0"
(and ignore-context "-C0")
"--ignore-space-change" "-"))
(unless magit-inhibit-refresh
(when magit-wip-after-apply-mode
(magit-wip-commit-after-apply files (concat " after " command)))
(magit-refresh))))
(defun magit-apply--get-selection ()
(or (magit-region-sections '(hunk file module) t)
(let ((section (magit-current-section)))
(pcase (oref section type)
((or 'hunk 'file 'module) section)
((or 'staged 'unstaged 'untracked
'stashed-index 'stashed-worktree 'stashed-untracked)
(oref section children))
(_ (user-error "Cannot apply this, it's not a change"))))))
(defun magit-apply--get-diffs (sections)
(magit-section-case
([file diffstat]
(--map (or (magit-get-section
(append `((file . ,(oref it value)))
(magit-section-ident magit-root-section)))
(error "Cannot get required diff headers"))
sections))
(t sections)))
(defun magit-apply--diff-ignores-whitespace-p ()
(and (cl-intersection magit-buffer-diff-args
'("--ignore-space-at-eol"
"--ignore-space-change"
"--ignore-all-space"
"--ignore-blank-lines")
:test #'equal)
t))
;;;; Stage
(defun magit-stage (&optional intent)
"Add the change at point to the staging area.
With a prefix argument, INTENT, and an untracked file (or files)
at point, stage the file but not its content."
(interactive "P")
(--if-let (and (derived-mode-p 'magit-mode) (magit-apply--get-selection))
(pcase (list (magit-diff-type)
(magit-diff-scope)
(magit-apply--diff-ignores-whitespace-p))
(`(untracked ,_ ,_) (magit-stage-untracked intent))
(`(unstaged region ,_) (magit-apply-region it "--cached"))
(`(unstaged hunk ,_) (magit-apply-hunk it "--cached"))
(`(unstaged hunks ,_) (magit-apply-hunks it "--cached"))
('(unstaged file t) (magit-apply-diff it "--cached"))
('(unstaged files t) (magit-apply-diffs it "--cached"))
('(unstaged list t) (magit-apply-diffs it "--cached"))
('(unstaged file nil) (magit-stage-1 "-u" (list (oref it value))))
('(unstaged files nil) (magit-stage-1 "-u" (magit-region-values nil t)))
('(unstaged list nil) (magit-stage-modified))
(`(staged ,_ ,_) (user-error "Already staged"))
(`(committed ,_ ,_) (user-error "Cannot stage committed changes"))
(`(undefined ,_ ,_) (user-error "Cannot stage this change")))
(call-interactively #'magit-stage-file)))
;;;###autoload
(defun magit-stage-file (file)
"Stage all changes to FILE.
With a prefix argument or when there is no file at point ask for
the file to be staged. Otherwise stage the file at point without
requiring confirmation."
(interactive
(let* ((atpoint (magit-section-value-if 'file))
(current (magit-file-relative-name))
(choices (nconc (magit-unstaged-files)
(magit-untracked-files)))
(default (car (member (or atpoint current) choices))))
(list (if (or current-prefix-arg (not default))
(magit-completing-read "Stage file" choices
nil t nil nil default)
default))))
(magit-with-toplevel
(magit-stage-1 nil (list file))))
;;;###autoload
(defun magit-stage-modified (&optional all)
"Stage all changes to files modified in the worktree.
Stage all new content of tracked files and remove tracked files
that no longer exist in the working tree from the index also.
With a prefix argument also stage previously untracked (but not
ignored) files."
(interactive "P")
(when (magit-anything-staged-p)
(magit-confirm 'stage-all-changes))
(magit-with-toplevel
(magit-stage-1 (if all "--all" "-u") magit-buffer-diff-files)))
(defun magit-stage-1 (arg &optional files)
(magit-wip-commit-before-change files " before stage")
(magit-run-git "add" arg (if files (cons "--" files) "."))
(when magit-auto-revert-mode
(mapc #'magit-turn-on-auto-revert-mode-if-desired files))
(magit-wip-commit-after-apply files " after stage"))
(defun magit-stage-untracked (&optional intent)
(let* ((section (magit-current-section))
(files (pcase (magit-diff-scope)
('file (list (oref section value)))
('files (magit-region-values nil t))
('list (magit-untracked-files))))
plain repos)
(dolist (file files)
(if (and (not (file-symlink-p file))
(magit-git-repo-p file t))
(push file repos)
(push file plain)))
(magit-wip-commit-before-change files " before stage")
(when plain
(magit-run-git "add" (and intent "--intent-to-add")
"--" plain)
(when magit-auto-revert-mode
(mapc #'magit-turn-on-auto-revert-mode-if-desired plain)))
(dolist (repo repos)
(save-excursion
(goto-char (oref (magit-get-section
`((file . ,repo) (untracked) (status)))
start))
(let* ((topdir (magit-toplevel))
(url (let ((default-directory
(file-name-as-directory (expand-file-name repo))))
(or (magit-get "remote" (magit-get-some-remote) "url")
(concat (file-name-as-directory ".") repo))))
(package
(and (equal (bound-and-true-p borg-user-emacs-directory)
topdir)
(file-name-nondirectory (directory-file-name repo)))))
(if (and package
(y-or-n-p (format "Also assimilate `%s' drone?" package)))
(borg-assimilate package url)
(magit-submodule-add-1
url repo (magit-submodule-read-name-for-path repo package))
(when package
(borg--sort-submodule-sections
(expand-file-name ".gitmodules" topdir))
(let ((default-directory borg-user-emacs-directory))
(borg--maybe-absorb-gitdir package)))))))
(magit-wip-commit-after-apply files " after stage")))
;;;; Unstage
(defun magit-unstage ()
"Remove the change at point from the staging area."
(interactive)
(--when-let (magit-apply--get-selection)
(pcase (list (magit-diff-type)
(magit-diff-scope)
(magit-apply--diff-ignores-whitespace-p))
(`(untracked ,_ ,_) (user-error "Cannot unstage untracked changes"))
(`(unstaged file ,_) (magit-unstage-intent (list (oref it value))))
(`(unstaged files ,_) (magit-unstage-intent (magit-region-values nil t)))
(`(unstaged ,_ ,_) (user-error "Already unstaged"))
(`(staged region ,_) (magit-apply-region it "--reverse" "--cached"))
(`(staged hunk ,_) (magit-apply-hunk it "--reverse" "--cached"))
(`(staged hunks ,_) (magit-apply-hunks it "--reverse" "--cached"))
('(staged file t) (magit-apply-diff it "--reverse" "--cached"))
('(staged files t) (magit-apply-diffs it "--reverse" "--cached"))
('(staged list t) (magit-apply-diffs it "--reverse" "--cached"))
('(staged file nil) (magit-unstage-1 (list (oref it value))))
('(staged files nil) (magit-unstage-1 (magit-region-values nil t)))
('(staged list nil) (magit-unstage-all))
(`(committed ,_ ,_) (if magit-unstage-committed
(magit-reverse-in-index)
(user-error "Cannot unstage committed changes")))
(`(undefined ,_ ,_) (user-error "Cannot unstage this change")))))
;;;###autoload
(defun magit-unstage-file (file)
"Unstage all changes to FILE.
With a prefix argument or when there is no file at point ask for
the file to be unstaged. Otherwise unstage the file at point
without requiring confirmation."
(interactive
(let* ((atpoint (magit-section-value-if 'file))
(current (magit-file-relative-name))
(choices (magit-staged-files))
(default (car (member (or atpoint current) choices))))
(list (if (or current-prefix-arg (not default))
(magit-completing-read "Unstage file" choices
nil t nil nil default)
default))))
(magit-with-toplevel
(magit-unstage-1 (list file))))
(defun magit-unstage-1 (files)
(magit-wip-commit-before-change files " before unstage")
(if (magit-no-commit-p)
(magit-run-git "rm" "--cached" "--" files)
(magit-run-git "reset" "HEAD" "--" files))
(magit-wip-commit-after-apply files " after unstage"))
(defun magit-unstage-intent (files)
(if-let ((staged (magit-staged-files))
(intent (--filter (member it staged) files)))
(magit-unstage-1 intent)
(user-error "Already unstaged")))
;;;###autoload
(defun magit-unstage-all ()
"Remove all changes from the staging area."
(interactive)
(unless (magit-anything-staged-p)
(user-error "Nothing to unstage"))
(when (or (magit-anything-unstaged-p)
(magit-untracked-files))
(magit-confirm 'unstage-all-changes))
(magit-wip-commit-before-change nil " before unstage")
(magit-run-git "reset" "HEAD" "--" magit-buffer-diff-files)
(magit-wip-commit-after-apply nil " after unstage"))
;;;; Discard
(defun magit-discard ()
"Remove the change at point.
On a hunk or file with unresolved conflicts prompt which side to
keep (while discarding the other). If point is within the text
of a side, then keep that side without prompting."
(interactive)
(--when-let (magit-apply--get-selection)
(pcase (list (magit-diff-type) (magit-diff-scope))
(`(committed ,_) (user-error "Cannot discard committed changes"))
(`(undefined ,_) (user-error "Cannot discard this change"))
(`(,_ region) (magit-discard-region it))
(`(,_ hunk) (magit-discard-hunk it))
(`(,_ hunks) (magit-discard-hunks it))
(`(,_ file) (magit-discard-file it))
(`(,_ files) (magit-discard-files it))
(`(,_ list) (magit-discard-files it)))))
(defun magit-discard-region (section)
(magit-confirm 'discard "Discard region")
(magit-discard-apply section 'magit-apply-region))
(defun magit-discard-hunk (section)
(magit-confirm 'discard "Discard hunk")
(let ((file (magit-section-parent-value section)))
(pcase (cddr (car (magit-file-status file)))
('(?U ?U) (magit-smerge-keep-current))
(_ (magit-discard-apply section #'magit-apply-hunk)))))
(defun magit-discard-apply (section apply)
(if (eq (magit-diff-type section) 'unstaged)
(funcall apply section "--reverse")
(if (magit-anything-unstaged-p
nil (if (magit-file-section-p section)
(oref section value)
(magit-section-parent-value section)))
(progn (let ((magit-inhibit-refresh t))
(funcall apply section "--reverse" "--cached")
(funcall apply section "--reverse" "--reject"))
(magit-refresh))
(funcall apply section "--reverse" "--index"))))
(defun magit-discard-hunks (sections)
(magit-confirm 'discard (format "Discard %s hunks from %s"
(length sections)
(magit-section-parent-value (car sections))))
(magit-discard-apply-n sections #'magit-apply-hunks))
(defun magit-discard-apply-n (sections apply)
(let ((section (car sections)))
(if (eq (magit-diff-type section) 'unstaged)
(funcall apply sections "--reverse")
(if (magit-anything-unstaged-p
nil (if (magit-file-section-p section)
(oref section value)
(magit-section-parent-value section)))
(progn (let ((magit-inhibit-refresh t))
(funcall apply sections "--reverse" "--cached")
(funcall apply sections "--reverse" "--reject"))
(magit-refresh))
(funcall apply sections "--reverse" "--index")))))
(defun magit-discard-file (section)
(magit-discard-files (list section)))
(defun magit-discard-files (sections)
(let ((auto-revert-verbose nil)
(type (magit-diff-type (car sections)))
(status (magit-file-status))
files delete resurrect rename discard discard-new resolve)
(dolist (section sections)
(let ((file (oref section value)))
(push file files)
(pcase (cons (pcase type
(`staged ?X)
(`unstaged ?Y)
(`untracked ?Z))
(cddr (assoc file status)))
('(?Z) (dolist (f (magit-untracked-files nil file))
(push f delete)))
((or '(?Z ?? ??) '(?Z ?! ?!)) (push file delete))
('(?Z ?D ? ) (push file delete))
(`(,_ ?D ?D) (push file resolve))
((or `(,_ ?U ,_) `(,_ ,_ ?U)) (push file resolve))
(`(,_ ?A ?A) (push file resolve))
(`(?X ?M ,(or ? ?M ?D)) (push section discard))
(`(?Y ,_ ?M ) (push section discard))
('(?X ?A ?M ) (push file discard-new))
('(?X ?C ?M ) (push file discard-new))
(`(?X ?A ,(or ? ?D)) (push file delete))
(`(?X ?C ,(or ? ?D)) (push file delete))
(`(?X ?D ,(or ? ?M )) (push file resurrect))
(`(?Y ,_ ?D ) (push file resurrect))
(`(?X ?R ,(or ? ?M ?D)) (push file rename)))))
(unwind-protect
(let ((magit-inhibit-refresh t))
(magit-wip-commit-before-change files " before discard")
(when resolve
(magit-discard-files--resolve (nreverse resolve)))
(when resurrect
(magit-discard-files--resurrect (nreverse resurrect)))
(when delete
(magit-discard-files--delete (nreverse delete) status))
(when rename
(magit-discard-files--rename (nreverse rename) status))
(when (or discard discard-new)
(magit-discard-files--discard (nreverse discard)
(nreverse discard-new)))
(magit-wip-commit-after-apply files " after discard"))
(magit-refresh))))
(defun magit-discard-files--resolve (files)
(if-let ((arg (and (cdr files)
(magit-read-char-case
(format "For these %i files\n%s\ncheckout:\n"
(length files)
(mapconcat (lambda (file)
(concat " " file))
files "\n"))
t
(?o "[o]ur stage" "--ours")
(?t "[t]heir stage" "--theirs")
(?c "[c]onflict" "--merge")
(?i "decide [i]ndividually" nil)))))
(dolist (file files)
(magit-checkout-stage file arg))
(dolist (file files)
(magit-checkout-stage file (magit-checkout-read-stage file)))))
(defun magit-discard-files--resurrect (files)
(magit-confirm-files 'resurrect files)
(if (eq (magit-diff-type) 'staged)
(magit-call-git "reset" "--" files)
(magit-call-git "checkout" "--" files)))
(defun magit-discard-files--delete (files status)
(magit-confirm-files (if magit-delete-by-moving-to-trash 'trash 'delete)
files)
(let ((delete-by-moving-to-trash magit-delete-by-moving-to-trash))
(dolist (file files)
(when (string-match-p "\\`\\\\?~" file)
(error "Refusing to delete %S, too dangerous" file))
(pcase (nth 3 (assoc file status))
((guard (memq (magit-diff-type) '(unstaged untracked)))
(dired-delete-file file dired-recursive-deletes
magit-delete-by-moving-to-trash)
(dired-clean-up-after-deletion file))
(?\s (delete-file file t)
(magit-call-git "rm" "--cached" "--" file))
(?M (let ((temp (magit-git-string "checkout-index" "--temp" file)))
(string-match
(format "\\(.+?\\)\t%s" (regexp-quote file)) temp)
(rename-file (match-string 1 temp)
(setq temp (concat file ".~{index}~")))
(delete-file temp t))
(magit-call-git "rm" "--cached" "--force" "--" file))
(?D (magit-call-git "checkout" "--" file)
(delete-file file t)
(magit-call-git "rm" "--cached" "--force" "--" file))))))
(defun magit-discard-files--rename (files status)
(magit-confirm 'rename "Undo rename %s" "Undo %i renames" nil
(mapcar (lambda (file)
(setq file (assoc file status))
(format "%s -> %s" (cadr file) (car file)))
files))
(dolist (file files)
(let ((orig (cadr (assoc file status))))
(if (file-exists-p file)
(progn
(--when-let (file-name-directory orig)
(make-directory it t))
(magit-call-git "mv" file orig))
(magit-call-git "rm" "--cached" "--" file)
(magit-call-git "reset" "--" orig)))))
(defun magit-discard-files--discard (sections new-files)
(let ((files (--map (oref it value) sections)))
(magit-confirm-files 'discard (append files new-files)
(format "Discard %s changes in" (magit-diff-type)))
(if (eq (magit-diff-type (car sections)) 'unstaged)
(magit-call-git "checkout" "--" files)
(when new-files
(magit-call-git "add" "--" new-files)
(magit-call-git "reset" "--" new-files))
(let ((binaries (magit-binary-files "--cached")))
(when binaries
(setq sections
(--remove (member (oref it value) binaries)
sections)))
(cond ((length= sections 1)
(magit-discard-apply (car sections) 'magit-apply-diff))
(sections
(magit-discard-apply-n sections #'magit-apply-diffs)))
(when binaries
(let ((modified (magit-unstaged-files t)))
(setq binaries (--separate (member it modified) binaries)))
(when (cadr binaries)
(magit-call-git "reset" "--" (cadr binaries)))
(when (car binaries)
(user-error
(concat
"Cannot discard staged changes to binary files, "
"which also have unstaged changes. Unstage instead."))))))))
;;;; Reverse
(defun magit-reverse (&rest args)
"Reverse the change at point in the working tree.
With a prefix argument fallback to a 3-way merge. Doing
so causes the change to be applied to the index as well."
(interactive (and current-prefix-arg (list "--3way")))
(--when-let (magit-apply--get-selection)
(pcase (list (magit-diff-type) (magit-diff-scope))
(`(untracked ,_) (user-error "Cannot reverse untracked changes"))
(`(unstaged ,_) (user-error "Cannot reverse unstaged changes"))
(`(,_ region) (magit-reverse-region it args))
(`(,_ hunk) (magit-reverse-hunk it args))
(`(,_ hunks) (magit-reverse-hunks it args))
(`(,_ file) (magit-reverse-file it args))
(`(,_ files) (magit-reverse-files it args))
(`(,_ list) (magit-reverse-files it args)))))
(defun magit-reverse-region (section args)
(magit-confirm 'reverse "Reverse region")
(magit-reverse-apply section #'magit-apply-region args))
(defun magit-reverse-hunk (section args)
(magit-confirm 'reverse "Reverse hunk")
(magit-reverse-apply section #'magit-apply-hunk args))
(defun magit-reverse-hunks (sections args)
(magit-confirm 'reverse
(format "Reverse %s hunks from %s"
(length sections)
(magit-section-parent-value (car sections))))
(magit-reverse-apply sections #'magit-apply-hunks args))
(defun magit-reverse-file (section args)
(magit-reverse-files (list section) args))
(defun magit-reverse-files (sections args)
(pcase-let ((`(,binaries ,sections)
(let ((bs (magit-binary-files
(cond ((derived-mode-p 'magit-revision-mode)
magit-buffer-range)
((derived-mode-p 'magit-diff-mode)
magit-buffer-range)
(t
"--cached")))))
(--separate (member (oref it value) bs)
sections))))
(magit-confirm-files 'reverse (--map (oref it value) sections))
(cond ((length= sections 1)
(magit-reverse-apply (car sections) #'magit-apply-diff args))
(sections
(magit-reverse-apply sections #'magit-apply-diffs args)))
(when binaries
(user-error "Cannot reverse binary files"))))
(defun magit-reverse-apply (section:s apply args)
(funcall apply section:s "--reverse" args
(and (not magit-reverse-atomically)
(not (member "--3way" args))
"--reject")))
(defun magit-reverse-in-index (&rest args)
"Reverse the change at point in the index but not the working tree.
Use this command to extract a change from `HEAD', while leaving
it in the working tree, so that it can later be committed using
a separate commit. A typical workflow would be:
0. Optionally make sure that there are no uncommitted changes.
1. Visit the `HEAD' commit and navigate to the change that should
not have been included in that commit.
2. Type \"u\" (`magit-unstage') to reverse it in the index.
This assumes that `magit-unstage-committed-changes' is non-nil.
3. Type \"c e\" to extend `HEAD' with the staged changes,
including those that were already staged before.
4. Optionally stage the remaining changes using \"s\" or \"S\"
and then type \"c c\" to create a new commit."
(interactive)
(magit-reverse (cons "--cached" args)))
;;; Smerge Support
(defun magit-smerge-keep-current ()
"Keep the current version of the conflict at point."
(interactive)
(magit-call-smerge #'smerge-keep-current))
(defun magit-smerge-keep-upper ()
"Keep the upper/our version of the conflict at point."
(interactive)
(magit-call-smerge #'smerge-keep-upper))
(defun magit-smerge-keep-base ()
"Keep the base version of the conflict at point."
(interactive)
(magit-call-smerge #'smerge-keep-base))
(defun magit-smerge-keep-lower ()
"Keep the lower/their version of the conflict at point."
(interactive)
(magit-call-smerge #'smerge-keep-lower))
(defun magit-call-smerge (fn)
(pcase-let* ((file (magit-file-at-point t t))
(keep (get-file-buffer file))
(`(,buf ,pos)
(let ((magit-diff-visit-jump-to-change nil))
(magit-diff-visit-file--noselect file))))
(with-current-buffer buf
(save-excursion
(save-restriction
(unless (<= (point-min) pos (point-max))
(widen))
(goto-char pos)
(condition-case nil
(smerge-match-conflict)
(error
(if (eq fn #'smerge-keep-current)
(when (eq this-command #'magit-discard)
(re-search-forward smerge-begin-re nil t)
(setq fn
(magit-read-char-case "Keep side: " t
(?o "[o]urs/upper" #'smerge-keep-upper)
(?b "[b]ase" #'smerge-keep-base)
(?t "[t]heirs/lower" #'smerge-keep-lower))))
(re-search-forward smerge-begin-re nil t))))
(funcall fn)))
(when (and keep (magit-anything-unmerged-p file))
(smerge-start-session))
(save-buffer))
(unless keep
(kill-buffer buf))
(magit-refresh)))
;;; _
(provide 'magit-apply)
;;; magit-apply.el ends here

2601
code/elpa/magit-20220425.1153/magit-autoloads.el Normal file
View file

File diff suppressed because it is too large Load diff

261
code/elpa/magit-20220425.1153/magit-autorevert.el Normal file
View file

@ -0,0 +1,261 @@
;;; magit-autorevert.el --- Revert buffers when files in repository change -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
(require 'magit-git)
(require 'autorevert)
;;; Options
(defgroup magit-auto-revert nil
"Revert buffers when files in repository change."
:link '(custom-group-link auto-revert)
:link '(info-link "(magit)Automatic Reverting of File-Visiting Buffers")
:group 'auto-revert
:group 'magit-essentials
:group 'magit-modes)
(defcustom auto-revert-buffer-list-filter nil
"Filter that determines which buffers `auto-revert-buffers' reverts.
This option is provided by Magit, which also advises
`auto-revert-buffers' to respect it. Magit users who do not turn
on the local mode `auto-revert-mode' themselves, are best served
by setting the value to `magit-auto-revert-repository-buffer-p'.
However the default is nil, so as not to disturb users who do use
the local mode directly. If you experience delays when running
Magit commands, then you should consider using one of the
predicates provided by Magit - especially if you also use Tramp.
Users who do turn on `auto-revert-mode' in buffers in which Magit
doesn't do that for them, should likely not use any filter.
Users who turn on `global-auto-revert-mode', do not have to worry
about this option, because it is disregarded if the global mode
is enabled."
:package-version '(magit . "2.4.2")
:group 'auto-revert
:group 'magit-auto-revert
:group 'magit-related
:type '(radio (const :tag "No filter" nil)
(function-item magit-auto-revert-buffer-p)
(function-item magit-auto-revert-repository-buffer-p)
function))
(defcustom magit-auto-revert-tracked-only t
"Whether `magit-auto-revert-mode' only reverts tracked files."
:package-version '(magit . "2.4.0")
:group 'magit-auto-revert
:type 'boolean
:set (lambda (var val)
(set var val)
(when (and (bound-and-true-p magit-auto-revert-mode)
(featurep 'magit-autorevert))
(magit-auto-revert-mode -1)
(magit-auto-revert-mode))))
(defcustom magit-auto-revert-immediately t
"Whether Magit reverts buffers immediately.
If this is non-nil and either `global-auto-revert-mode' or
`magit-auto-revert-mode' is enabled, then Magit immediately
reverts buffers by explicitly calling `auto-revert-buffers'
after running Git for side-effects.
If `auto-revert-use-notify' is non-nil (and file notifications
are actually supported), then `magit-auto-revert-immediately'
does not have to be non-nil, because the reverts happen
immediately anyway.
If `magit-auto-revert-immediately' and `auto-revert-use-notify'
are both nil, then reverts happen after `auto-revert-interval'
seconds of user inactivity. That is not desirable."
:package-version '(magit . "2.4.0")
:group 'magit-auto-revert
:type 'boolean)
;;; Mode
(defun magit-turn-on-auto-revert-mode-if-desired (&optional file)
(if file
(--when-let (find-buffer-visiting file)
(with-current-buffer it
(magit-turn-on-auto-revert-mode-if-desired)))
(when (and (not auto-revert-mode) ; see #3014
(not global-auto-revert-mode) ; see #3460
buffer-file-name
(file-readable-p buffer-file-name)
(compat-executable-find (magit-git-executable) t)
(magit-toplevel)
(or (not magit-auto-revert-tracked-only)
(magit-file-tracked-p buffer-file-name)))
(auto-revert-mode 1))))
;;;###autoload
(define-globalized-minor-mode magit-auto-revert-mode auto-revert-mode
magit-turn-on-auto-revert-mode-if-desired
:package-version '(magit . "2.4.0")
:link '(info-link "(magit)Automatic Reverting of File-Visiting Buffers")
:group 'magit-auto-revert
:group 'magit-essentials
;; - When `global-auto-revert-mode' is enabled, then this mode is
;; redundant.
;; - In all other cases enable the mode because if buffers are not
;; automatically reverted that would make many very common tasks
;; much more cumbersome.
:init-value (not (or global-auto-revert-mode
noninteractive)))
;; - Unfortunately `:init-value t' only sets the value of the mode
;; variable but does not cause the mode function to be called.
;; - I don't think it works like this on purpose, but since one usually
;; should not enable global modes by default, it is understandable.
;; - If the user has set the variable `magit-auto-revert-mode' to nil
;; after loading magit (instead of doing so before loading magit or
;; by using the function), then we should still respect that setting.
;; - If the user sets one of these variables after loading magit and
;; after `after-init-hook' has run, then that won't have an effect
;; and there is nothing we can do about it.
(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 magit-auto-revert-mode
(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-subtract nil start))))
(if (> elapsed 0.2)
(format " (%.3fs, %s buffers checked)" elapsed
(length (buffer-list)))
""))))
(magit-auto-revert-mode -1)))
(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
"Toggle Magit Auto Revert mode.
If called interactively, enable Magit Auto Revert mode if ARG is
positive, and disable it if ARG is zero or negative. If called
from Lisp, also enable the mode if ARG is omitted or nil, and
toggle it if ARG is `toggle'; disable the mode otherwise.
Magit Auto Revert mode is a global minor mode that reverts
buffers associated with a file that is located inside a Git
repository when the file changes on disk. Use `auto-revert-mode'
to revert a particular buffer. Or use `global-auto-revert-mode'
to revert all file-visiting buffers, not just those that visit
a file located inside a Git repository.
This global mode works by turning on the buffer-local mode
`auto-revert-mode' at the time a buffer is first created. The
local mode is turned on if the visited file is being tracked in
a Git repository at the time when the buffer is created.
If `magit-auto-revert-tracked-only' is non-nil (the default),
then only tracked files are reverted. But if you stage a
previously untracked file using `magit-stage', then this mode
notices that.
Unlike `global-auto-revert-mode', this mode never reverts any
buffers that are not visiting files.
The behavior of this mode can be customized using the options
in the `autorevert' and `magit-autorevert' groups.
This function calls the hook `magit-auto-revert-mode-hook'.
Like nearly every mode, this mode should be enabled or disabled
by calling the respective mode function, the reason being that
changing the state of a mode involves more than merely toggling
a single switch, so setting the mode variable is not enough.
Also, you should not use `after-init-hook' to disable this mode.")
(defun magit-auto-revert-buffers ()
(when (and magit-auto-revert-immediately
(or global-auto-revert-mode
(and magit-auto-revert-mode auto-revert-buffer-list)))
(let ((auto-revert-buffer-list-filter
(or auto-revert-buffer-list-filter
#'magit-auto-revert-repository-buffer-p)))
(auto-revert-buffers))))
(defvar magit-auto-revert-toplevel nil)
(defvar magit-auto-revert-counter 1
"Incremented each time `auto-revert-buffers' is called.")
(defun magit-auto-revert-buffer-p (buffer)
"Return non-nil if BUFFER visits a file inside the current repository.
The current repository is the one containing `default-directory'.
If there is no current repository, then return t for any BUFFER."
(magit-auto-revert-repository-buffer-p buffer t))
(defun magit-auto-revert-repository-buffer-p (buffer &optional fallback)
"Return non-nil if BUFFER visits a file inside the current repository.
The current repository is the one containing `default-directory'.
If there is no current repository, then return FALLBACK (which
defaults to nil) for any BUFFER."
;; Call `magit-toplevel' just once per cycle.
(unless (and magit-auto-revert-toplevel
(= (cdr magit-auto-revert-toplevel)
magit-auto-revert-counter))
(setq magit-auto-revert-toplevel
(cons (or (magit-toplevel) 'no-repo)
magit-auto-revert-counter)))
(let ((top (car magit-auto-revert-toplevel)))
(if (eq top 'no-repo)
fallback
(let ((dir (buffer-local-value 'default-directory buffer)))
(and (equal (file-remote-p dir)
(file-remote-p top))
;; ^ `tramp-handle-file-in-directory-p' lacks this optimization.
(file-in-directory-p dir top))))))
(defun auto-revert-buffers--buffer-list-filter (fn)
(cl-incf magit-auto-revert-counter)
(if (or global-auto-revert-mode
(not auto-revert-buffer-list)
(not auto-revert-buffer-list-filter))
(funcall fn)
(let ((auto-revert-buffer-list
(-filter auto-revert-buffer-list-filter
auto-revert-buffer-list)))
(funcall fn))
(unless auto-revert-timer
(auto-revert-set-timer))))
(advice-add 'auto-revert-buffers :around
#'auto-revert-buffers--buffer-list-filter)
;;; _
(provide 'magit-autorevert)
;;; magit-autorevert.el ends here

1273
code/elpa/magit-20220425.1153/magit-base.el Normal file
View file

File diff suppressed because it is too large Load diff

307
code/elpa/magit-20220425.1153/magit-bisect.el Normal file
View file

@ -0,0 +1,307 @@
;;; magit-bisect.el --- Bisect support for Magit -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Use a binary search to find the commit that introduced a bug.
;;; Code:
(require 'magit)
;;; Options
(defcustom magit-bisect-show-graph t
"Whether to use `--graph' in the log showing commits yet to be bisected."
:package-version '(magit . "2.8.0")
:group 'magit-status
:type 'boolean)
(defface magit-bisect-good
'((t :foreground "DarkOliveGreen"))
"Face for good bisect revisions."
:group 'magit-faces)
(defface magit-bisect-skip
'((t :foreground "DarkGoldenrod"))
"Face for skipped bisect revisions."
:group 'magit-faces)
(defface magit-bisect-bad
'((t :foreground "IndianRed4"))
"Face for bad bisect revisions."
:group 'magit-faces)
;;; Commands
;;;###autoload (autoload 'magit-bisect "magit-bisect" nil t)
(transient-define-prefix magit-bisect ()
"Narrow in on the commit that introduced a bug."
:man-page "git-bisect"
[:class transient-subgroups
:if-not magit-bisect-in-progress-p
["Arguments"
("-n" "Don't checkout commits" "--no-checkout")
("-p" "Follow only first parent of a merge" "--first-parent"
:if (lambda () (magit-git-version>= "2.29")))
(6 magit-bisect:--term-old
:if (lambda () (magit-git-version>= "2.7")))
(6 magit-bisect:--term-new
:if (lambda () (magit-git-version>= "2.7")))]
["Actions"
("B" "Start" magit-bisect-start)
("s" "Start script" magit-bisect-run)]]
["Actions"
:if magit-bisect-in-progress-p
("B" "Bad" magit-bisect-bad)
("g" "Good" magit-bisect-good)
(6 "m" "Mark" magit-bisect-mark
:if (lambda () (magit-git-version>= "2.7")))
("k" "Skip" magit-bisect-skip)
("r" "Reset" magit-bisect-reset)
("s" "Run script" magit-bisect-run)])
(transient-define-argument magit-bisect:--term-old ()
:description "Old/good term"
:class 'transient-option
:key "=o"
:argument "--term-old=")
(transient-define-argument magit-bisect:--term-new ()
:description "New/bad term"
:class 'transient-option
:key "=n"
:argument "--term-new=")
;;;###autoload
(defun magit-bisect-start (bad good args)
"Start a bisect session.
Bisecting a bug means to find the commit that introduced it.
This command starts such a bisect session by asking for a known
good and a known bad commit. To move the session forward use the
other actions from the bisect transient command (\
\\<magit-status-mode-map>\\[magit-bisect])."
(interactive (if (magit-bisect-in-progress-p)
(user-error "Already bisecting")
(magit-bisect-start-read-args)))
(unless (magit-rev-ancestor-p good bad)
(user-error
"The %s revision (%s) has to be an ancestor of the %s one (%s)"
(or (transient-arg-value "--term-old=" args) "good")
good
(or (transient-arg-value "--term-new=" args) "bad")
bad))
(when (magit-anything-modified-p)
(user-error "Cannot bisect with uncommitted changes"))
(magit-git-bisect "start" (list args bad good) t))
(defun magit-bisect-start-read-args ()
(let* ((args (transient-args 'magit-bisect))
(bad (magit-read-branch-or-commit
(format "Start bisect with %s revision"
(or (transient-arg-value "--term-new=" args)
"bad")))))
(list bad
(magit-read-other-branch-or-commit
(format "%s revision" (or (transient-arg-value "--term-old=" args)
"Good"))
bad)
args)))
;;;###autoload
(defun magit-bisect-reset ()
"After bisecting, cleanup bisection state and return to original `HEAD'."
(interactive)
(magit-confirm 'reset-bisect)
(magit-run-git "bisect" "reset")
(ignore-errors (delete-file (magit-git-dir "BISECT_CMD_OUTPUT"))))
;;;###autoload
(defun magit-bisect-good ()
"While bisecting, mark the current commit as good.
Use this after you have asserted that the commit does not contain
the bug in question."
(interactive)
(magit-git-bisect (or (cadr (magit-bisect-terms))
(user-error "Not bisecting"))))
;;;###autoload
(defun magit-bisect-bad ()
"While bisecting, mark the current commit as bad.
Use this after you have asserted that the commit does contain the
bug in question."
(interactive)
(magit-git-bisect (or (car (magit-bisect-terms))
(user-error "Not bisecting"))))
;;;###autoload
(defun magit-bisect-mark ()
"While bisecting, mark the current commit with a bisect term.
During a bisect using alternate terms, commits can still be
marked with `magit-bisect-good' and `magit-bisect-bad', as those
commands map to the correct term (\"good\" to --term-old's value
and \"bad\" to --term-new's). However, in some cases, it can be
difficult to keep that mapping straight in your head; this
command provides an interface that exposes the underlying terms."
(interactive)
(magit-git-bisect
(pcase-let ((`(,term-new ,term-old) (or (magit-bisect-terms)
(user-error "Not bisecting"))))
(pcase (read-char-choice
(format "Mark HEAD as %s ([n]ew) or %s ([o]ld)"
term-new term-old)
(list ?n ?o))
(?n term-new)
(?o term-old)))))
;;;###autoload
(defun magit-bisect-skip ()
"While bisecting, skip the current commit.
Use this if for some reason the current commit is not a good one
to test. This command lets Git choose a different one."
(interactive)
(magit-git-bisect "skip"))
;;;###autoload
(defun magit-bisect-run (cmdline &optional bad good args)
"Bisect automatically by running commands after each step.
Unlike `git bisect run' this can be used before bisecting has
begun. In that case it behaves like `git bisect start; git
bisect run'."
(interactive (let ((args (and (not (magit-bisect-in-progress-p))
(magit-bisect-start-read-args))))
(cons (read-shell-command "Bisect shell command: ") args)))
(when (and bad good)
;; Avoid `magit-git-bisect' because it's asynchronous, but the
;; next `git bisect run' call requires the bisect to be started.
(magit-with-toplevel
(magit-process-git
(list :file (magit-git-dir "BISECT_CMD_OUTPUT"))
(magit-process-git-arguments
(list "bisect" "start" bad good args)))
(magit-refresh)))
(magit--with-connection-local-variables
(magit-git-bisect "run" (list shell-file-name
shell-command-switch cmdline))))
(defun magit-git-bisect (subcommand &optional args no-assert)
(unless (or no-assert (magit-bisect-in-progress-p))
(user-error "Not bisecting"))
(message "Bisecting...")
(magit-with-toplevel
(magit-run-git-async "bisect" subcommand args))
(set-process-sentinel
magit-this-process
(lambda (process event)
(when (memq (process-status process) '(exit signal))
(if (> (process-exit-status process) 0)
(magit-process-sentinel process event)
(process-put process 'inhibit-refresh t)
(magit-process-sentinel process event)
(when (buffer-live-p (process-buffer process))
(with-current-buffer (process-buffer process)
(when-let* ((section (magit-section-at))
(output (buffer-substring-no-properties
(oref section content)
(oref section end))))
(with-temp-file (magit-git-dir "BISECT_CMD_OUTPUT")
(insert output)))))
(magit-refresh))
(message "Bisecting...done")))))
;;; Sections
(defun magit-bisect-in-progress-p ()
(file-exists-p (magit-git-dir "BISECT_LOG")))
(defun magit-bisect-terms ()
(magit-file-lines (magit-git-dir "BISECT_TERMS")))
(defun magit-insert-bisect-output ()
"While bisecting, insert section with output from `git bisect'."
(when (magit-bisect-in-progress-p)
(let* ((lines
(or (magit-file-lines (magit-git-dir "BISECT_CMD_OUTPUT"))
(list "Bisecting: (no saved bisect output)"
"It appears you have invoked `git bisect' from a shell."
"There is nothing wrong with that, we just cannot display"
"anything useful here. Consult the shell output instead.")))
(done-re "^\\([a-z0-9]\\{40,\\}\\) is the first bad commit$")
(bad-line (or (and (string-match done-re (car lines))
(pop lines))
(--first (string-match done-re it) lines))))
(magit-insert-section ((eval (if bad-line 'commit 'bisect-output))
(and bad-line (match-string 1 bad-line)))
(magit-insert-heading
(propertize (or bad-line (pop lines))
'font-lock-face 'magit-section-heading))
(dolist (line lines)
(insert line "\n"))))
(insert "\n")))
(defun magit-insert-bisect-rest ()
"While bisecting, insert section visualizing the bisect state."
(when (magit-bisect-in-progress-p)
(magit-insert-section (bisect-view)
(magit-insert-heading "Bisect Rest:")
(magit-git-wash (apply-partially #'magit-log-wash-log 'bisect-vis)
"bisect" "visualize" "git" "log"
"--format=%h%x00%D%x00%s" "--decorate=full"
(and magit-bisect-show-graph "--graph")))))
(defun magit-insert-bisect-log ()
"While bisecting, insert section logging bisect progress."
(when (magit-bisect-in-progress-p)
(magit-insert-section (bisect-log)
(magit-insert-heading "Bisect Log:")
(magit-git-wash #'magit-wash-bisect-log "bisect" "log")
(insert ?\n))))
(defun magit-wash-bisect-log (_args)
(let (beg)
(while (progn (setq beg (point-marker))
(re-search-forward "^\\(git bisect [^\n]+\n\\)" nil t))
(magit-bind-match-strings (heading) nil
(magit-delete-match)
(save-restriction
(narrow-to-region beg (point))
(goto-char (point-min))
(magit-insert-section (bisect-item heading t)
(insert (propertize heading 'font-lock-face
'magit-section-secondary-heading))
(magit-insert-heading)
(magit-wash-sequence
(apply-partially #'magit-log-wash-rev 'bisect-log
(magit-abbrev-length)))
(insert ?\n)))))
(when (re-search-forward
"# first bad commit: \\[\\([a-z0-9]\\{40,\\}\\)\\] [^\n]+\n" nil t)
(magit-bind-match-strings (hash) nil
(magit-delete-match)
(magit-insert-section (bisect-item)
(insert hash " is the first bad commit\n"))))))
;;; _
(provide 'magit-bisect)
;;; magit-bisect.el ends here

981
code/elpa/magit-20220425.1153/magit-blame.el Normal file
View file

@ -0,0 +1,981 @@
;;; magit-blame.el --- Blame support for Magit -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Annotates each line in file-visiting buffer with information from
;; the revision which last modified the line.
;;; Code:
(require 'magit)
;;; Options
(defgroup magit-blame nil
"Blame support for Magit."
:link '(info-link "(magit)Blaming")
:group 'magit-modes)
(defcustom magit-blame-styles
'((headings
(heading-format . "%-20a %C %s\n"))
(highlight
(highlight-face . magit-blame-highlight))
(lines
(show-lines . t)
(show-message . t)))
"List of styles used to visualize blame information.
The style used in the current buffer can be cycled from the blame
popup. Blame commands (except `magit-blame-echo') use the first
style as the initial style when beginning to blame in a buffer.
Each entry has the form (IDENT (KEY . VALUE)...). IDENT has
to be a symbol uniquely identifying the style. The following
KEYs are recognized:
`show-lines'
Whether to prefix each chunk of lines with a thin line.
This has no effect if `heading-format' is non-nil.
`show-message'
Whether to display a commit's summary line in the echo area
when crossing chunks.
`highlight-face'
Face used to highlight the first line of each chunk.
If this is nil, then those lines are not highlighted.
`heading-format'
String specifying the information to be shown above each
chunk of lines. It must end with a newline character.
`margin-format'
String specifying the information to be shown in the left
buffer margin. It must NOT end with a newline character.
This can also be a list of formats used for the lines at
the same positions within the chunk. If the chunk has
more lines than formats are specified, then the last is
repeated. WARNING: Adding this key affects performance;
see the note at the end of this docstring.
`margin-width'
Width of the margin, provided `margin-format' is non-nil.
`margin-face'
Face used in the margin, provided `margin-format' is
non-nil. This face is used in combination with the faces
that are specific to the used %-specs. If this is nil,
then `magit-blame-margin' is used.
`margin-body-face'
Face used in the margin for all but first line of a chunk.
This face is used in combination with the faces that are
specific to the used %-specs. This can also be a list of
faces (usually one face), in which case only these faces
are used and the %-spec faces are ignored. A good value
might be `(magit-blame-dimmed)'. If this is nil, then
the same face as for the first line is used.
The following %-specs can be used in `heading-format' and
`margin-format':
%H hash using face `magit-blame-hash'
%s summary using face `magit-blame-summary'
%a author using face `magit-blame-name'
%A author time using face `magit-blame-date'
%c committer using face `magit-blame-name'
%C committer time using face `magit-blame-date'
Additionally if `margin-format' ends with %f, then the string
that is displayed in the margin is made at least `margin-width'
characters wide, which may be desirable if the used face sets
the background color.
Blame information is displayed using overlays. Such extensive
use of overlays is known to slow down even basic operations, such
as moving the cursor. To reduce the number of overlays the margin
style had to be removed from the default value of this option.
Note that the margin overlays are created even if another style
is currently active. This can only be prevented by not even
defining a style that uses the margin. If you want to use this
style anyway, you can restore this definition, which used to be
part of the default value:
(margin
(margin-format . (\" %s%f\" \" %C %a\" \" %H\"))
(margin-width . 42)
(margin-face . magit-blame-margin)
(margin-body-face . (magit-blame-dimmed)))"
:package-version '(magit . "2.13.0")
:group 'magit-blame
:type 'string)
(defcustom magit-blame-echo-style 'lines
"The blame visualization style used by `magit-blame-echo'.
A symbol that has to be used as the identifier for one of the
styles defined in `magit-blame-styles'."
:package-version '(magit . "2.13.0")
:group 'magit-blame
:type 'symbol)
(defcustom magit-blame-time-format "%F %H:%M"
"Format for time strings in blame headings."
:group 'magit-blame
:type 'string)
(defcustom magit-blame-read-only t
"Whether to initially make the blamed buffer read-only."
:package-version '(magit . "2.13.0")
:group 'magit-blame
:type 'boolean)
(defcustom magit-blame-disable-modes '(fci-mode yascroll-bar-mode)
"List of modes not compatible with Magit-Blame mode.
This modes are turned off when Magit-Blame mode is turned on,
and then turned on again when turning off the latter."
:group 'magit-blame
:type '(repeat (symbol :tag "Mode")))
(defcustom magit-blame-mode-lighter " Blame"
"The mode-line lighter of the Magit-Blame mode."
:group 'magit-blame
:type '(choice (const :tag "No lighter" "") string))
(defcustom magit-blame-goto-chunk-hook
'(magit-blame-maybe-update-revision-buffer
magit-blame-maybe-show-message)
"Hook run after point entered another chunk."
:package-version '(magit . "2.13.0")
:group 'magit-blame
:type 'hook
:get #'magit-hook-custom-get
:options '(magit-blame-maybe-update-revision-buffer
magit-blame-maybe-show-message))
;;; Faces
(defface magit-blame-highlight
`((((class color) (background light))
,@(and (>= emacs-major-version 27) '(:extend t))
:background "grey80"
:foreground "black")
(((class color) (background dark))
,@(and (>= emacs-major-version 27) '(:extend t))
:background "grey25"
:foreground "white"))
"Face used for highlighting when blaming.
Also see option `magit-blame-styles'."
:group 'magit-faces)
(defface magit-blame-margin
'((t :inherit magit-blame-highlight
:weight normal
:slant normal))
"Face used for the blame margin by default when blaming.
Also see option `magit-blame-styles'."
:group 'magit-faces)
(defface magit-blame-dimmed
'((t :inherit magit-dimmed
:weight normal
:slant normal))
"Face used for the blame margin in some cases when blaming.
Also see option `magit-blame-styles'."
:group 'magit-faces)
(defface magit-blame-heading
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:inherit magit-blame-highlight
:weight normal
:slant normal))
"Face used for blame headings by default when blaming.
Also see option `magit-blame-styles'."
:group 'magit-faces)
(defface magit-blame-summary '((t nil))
"Face used for commit summaries when blaming."
:group 'magit-faces)
(defface magit-blame-hash '((t nil))
"Face used for commit hashes when blaming."
:group 'magit-faces)
(defface magit-blame-name '((t nil))
"Face used for author and committer names when blaming."
:group 'magit-faces)
(defface magit-blame-date '((t nil))
"Face used for dates when blaming."
:group 'magit-faces)
;;; Chunks
(defclass magit-blame-chunk ()
(;; <orig-rev> <orig-line> <final-line> <num-lines>
(orig-rev :initarg :orig-rev)
(orig-line :initarg :orig-line)
(final-line :initarg :final-line)
(num-lines :initarg :num-lines)
;; previous <prev-rev> <prev-file>
(prev-rev :initform nil)
(prev-file :initform nil)
;; filename <orig-file>
(orig-file)))
(defun magit-current-blame-chunk (&optional type noerror)
(or (and (not (and type (not (eq type magit-blame-type))))
(magit-blame-chunk-at (point)))
(and type
(let ((rev (or magit-buffer-refname magit-buffer-revision))
(file (and (not (derived-mode-p 'dired-mode))
(magit-file-relative-name
nil (not magit-buffer-file-name))))
(line (format "%i,+1" (line-number-at-pos))))
(cond (file (with-temp-buffer
(magit-with-toplevel
(magit-git-insert
"blame" "--porcelain"
(if (memq magit-blame-type '(final removal))
(cons "--reverse" (magit-blame-arguments))
(magit-blame-arguments))
"-L" line rev "--" file)
(goto-char (point-min))
(car (magit-blame--parse-chunk type)))))
(noerror nil)
(t (error "Buffer does not visit a tracked file")))))))
(defun magit-blame-chunk-at (pos)
(--some (overlay-get it 'magit-blame-chunk)
(overlays-at pos)))
(defun magit-blame--overlay-at (&optional pos key)
(unless pos
(setq pos (point)))
(--first (overlay-get it (or key 'magit-blame-chunk))
(nconc (overlays-at pos)
(overlays-in pos pos))))
;;; Keymaps
(defvar magit-blame-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-c C-q") 'magit-blame-quit)
map)
"Keymap for `magit-blame-mode'.
Note that most blaming key bindings are defined
in `magit-blame-read-only-mode-map' instead.")
(defvar magit-blame-read-only-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-m") #'magit-show-commit)
(define-key map (kbd "p") #'magit-blame-previous-chunk)
(define-key map (kbd "P") #'magit-blame-previous-chunk-same-commit)
(define-key map (kbd "n") #'magit-blame-next-chunk)
(define-key map (kbd "N") #'magit-blame-next-chunk-same-commit)
(define-key map (kbd "b") #'magit-blame-addition)
(define-key map (kbd "r") #'magit-blame-removal)
(define-key map (kbd "f") #'magit-blame-reverse)
(define-key map (kbd "B") #'magit-blame)
(define-key map (kbd "c") #'magit-blame-cycle-style)
(define-key map (kbd "q") #'magit-blame-quit)
(define-key map (kbd "M-w") #'magit-blame-copy-hash)
(define-key map (kbd "SPC") #'magit-diff-show-or-scroll-up)
(define-key map (kbd "S-SPC") #'magit-diff-show-or-scroll-down)
(define-key map (kbd "DEL") #'magit-diff-show-or-scroll-down)
map)
"Keymap for `magit-blame-read-only-mode'.")
;;; Modes
;;;; Variables
(defvar-local magit-blame-buffer-read-only nil)
(defvar-local magit-blame-cache nil)
(defvar-local magit-blame-disabled-modes nil)
(defvar-local magit-blame-process nil)
(defvar-local magit-blame-recursive-p nil)
(defvar-local magit-blame-type nil)
(defvar-local magit-blame-separator nil)
(defvar-local magit-blame-previous-chunk nil)
(defvar-local magit-blame--make-margin-overlays nil)
(defvar-local magit-blame--style nil)
(defsubst magit-blame--style-get (key)
(cdr (assoc key (cdr magit-blame--style))))
;;;; Base Mode
(define-minor-mode magit-blame-mode
"Display blame information inline."
:lighter magit-blame-mode-lighter
(cond (magit-blame-mode
(when (called-interactively-p 'any)
(setq magit-blame-mode nil)
(user-error
(concat "Don't call `magit-blame-mode' directly; "
"instead use `magit-blame'")))
(add-hook 'after-save-hook #'magit-blame--refresh t t)
(add-hook 'post-command-hook #'magit-blame-goto-chunk-hook t t)
(add-hook 'before-revert-hook #'magit-blame--remove-overlays t t)
(add-hook 'after-revert-hook #'magit-blame--refresh t t)
(add-hook 'read-only-mode-hook #'magit-blame-toggle-read-only t t)
(setq magit-blame-buffer-read-only buffer-read-only)
(when (or magit-blame-read-only magit-buffer-file-name)
(read-only-mode 1))
(dolist (mode magit-blame-disable-modes)
(when (and (boundp mode) (symbol-value mode))
(funcall mode -1)
(push mode magit-blame-disabled-modes)))
(setq magit-blame-separator (magit-blame--format-separator))
(unless magit-blame--style
(setq magit-blame--style (car magit-blame-styles)))
(setq magit-blame--make-margin-overlays
(and (cl-find-if (lambda (style)
(assq 'margin-format (cdr style)))
magit-blame-styles)))
(magit-blame--update-margin))
(t
(when (process-live-p magit-blame-process)
(kill-process magit-blame-process)
(while magit-blame-process
(sit-for 0.01))) ; avoid racing the sentinel
(remove-hook 'after-save-hook #'magit-blame--refresh t)
(remove-hook 'post-command-hook #'magit-blame-goto-chunk-hook t)
(remove-hook 'before-revert-hook #'magit-blame--remove-overlays t)
(remove-hook 'after-revert-hook #'magit-blame--refresh t)
(remove-hook 'read-only-mode-hook #'magit-blame-toggle-read-only t)
(unless magit-blame-buffer-read-only
(read-only-mode -1))
(magit-blame-read-only-mode -1)
(dolist (mode magit-blame-disabled-modes)
(funcall mode 1))
(kill-local-variable 'magit-blame-disabled-modes)
(kill-local-variable 'magit-blame-type)
(kill-local-variable 'magit-blame--style)
(magit-blame--update-margin)
(magit-blame--remove-overlays))))
(defun magit-blame--refresh ()
(magit-blame--run (magit-blame-arguments)))
(defun magit-blame-goto-chunk-hook ()
(let ((chunk (magit-blame-chunk-at (point))))
(when (cl-typep chunk 'magit-blame-chunk)
(unless (eq chunk magit-blame-previous-chunk)
(run-hooks 'magit-blame-goto-chunk-hook))
(setq magit-blame-previous-chunk chunk))))
(defun magit-blame-toggle-read-only ()
(magit-blame-read-only-mode (if buffer-read-only 1 -1)))
;;;; Read-Only Mode
(define-minor-mode magit-blame-read-only-mode
"Provide keybindings for Magit-Blame mode.
This minor-mode provides the key bindings for Magit-Blame mode,
but only when Read-Only mode is also enabled because these key
bindings would otherwise conflict badly with regular bindings.
When both Magit-Blame mode and Read-Only mode are enabled, then
this mode gets automatically enabled too and when one of these
modes is toggled, then this mode also gets toggled automatically.
\\{magit-blame-read-only-mode-map}")
;;;; Kludges
(defun magit-blame-put-keymap-before-view-mode ()
"Put `magit-blame-read-only-mode' ahead of `view-mode' in `minor-mode-map-alist'."
(--when-let (assq 'magit-blame-read-only-mode
(cl-member 'view-mode minor-mode-map-alist :key #'car))
(setq minor-mode-map-alist
(cons it (delq it minor-mode-map-alist))))
(remove-hook 'view-mode-hook #'magit-blame-put-keymap-before-view-mode))
(add-hook 'view-mode-hook #'magit-blame-put-keymap-before-view-mode)
;;; Process
(defun magit-blame--run (args)
(magit-with-toplevel
(unless magit-blame-mode
(magit-blame-mode 1))
(message "Blaming...")
(magit-blame-run-process
(or magit-buffer-refname magit-buffer-revision)
(magit-file-relative-name nil (not magit-buffer-file-name))
(if (memq magit-blame-type '(final removal))
(cons "--reverse" args)
args)
(list (line-number-at-pos (window-start))
(line-number-at-pos (1- (window-end nil t)))))
(set-process-sentinel magit-this-process
#'magit-blame-process-quickstart-sentinel)))
(defun magit-blame-run-process (revision file args &optional lines)
(let ((process (magit-parse-git-async
"blame" "--incremental" args
(and lines (list "-L" (apply #'format "%s,%s" lines)))
revision "--" file)))
(set-process-filter process #'magit-blame-process-filter)
(set-process-sentinel process #'magit-blame-process-sentinel)
(process-put process 'arguments (list revision file args))
(setq magit-blame-cache (make-hash-table :test #'equal))
(setq magit-blame-process process)))
(defun magit-blame-process-quickstart-sentinel (process event)
(when (memq (process-status process) '(exit signal))
(magit-blame-process-sentinel process event t)
(magit-blame-assert-buffer process)
(with-current-buffer (process-get process 'command-buf)
(when magit-blame-mode
(let ((default-directory (magit-toplevel)))
(apply #'magit-blame-run-process
(process-get process 'arguments)))))))
(defun magit-blame-process-sentinel (process _event &optional quiet)
(let ((status (process-status process)))
(when (memq status '(exit signal))
(kill-buffer (process-buffer process))
(if (and (eq status 'exit)
(zerop (process-exit-status process)))
(unless quiet
(message "Blaming...done"))
(magit-blame-assert-buffer process)
(with-current-buffer (process-get process 'command-buf)
(if magit-blame-mode
(progn (magit-blame-mode -1)
(message "Blaming...failed"))
(message "Blaming...aborted"))))
(kill-local-variable 'magit-blame-process))))
(defun magit-blame-process-filter (process string)
(internal-default-process-filter process string)
(let ((buf (process-get process 'command-buf))
(pos (process-get process 'parsed))
(mark (process-mark process))
type cache)
(with-current-buffer buf
(setq type magit-blame-type)
(setq cache magit-blame-cache))
(with-current-buffer (process-buffer process)
(goto-char pos)
(while (and (< (point) mark)
(save-excursion (re-search-forward "^filename .+\n" nil t)))
(pcase-let* ((`(,chunk ,revinfo)
(magit-blame--parse-chunk type))
(rev (oref chunk orig-rev)))
(if revinfo
(puthash rev revinfo cache)
(setq revinfo
(or (gethash rev cache)
(puthash rev (magit-blame--commit-alist rev) cache))))
(magit-blame--make-overlays buf chunk revinfo))
(process-put process 'parsed (point))))))
(defun magit-blame--parse-chunk (type)
(let (chunk revinfo)
(unless (looking-at "^\\(.\\{40,\\}\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\)")
(error "Blaming failed due to unexpected output: %s"
(buffer-substring-no-properties (point) (line-end-position))))
(with-slots (orig-rev orig-file prev-rev prev-file)
(setq chunk (magit-blame-chunk
:orig-rev (match-string 1)
:orig-line (string-to-number (match-string 2))
:final-line (string-to-number (match-string 3))
:num-lines (string-to-number (match-string 4))))
(forward-line)
(let (done)
(while (not done)
(cond ((looking-at "^filename \\(.+\\)")
(setq done t)
(setf orig-file (magit-decode-git-path (match-string 1))))
((looking-at "^previous \\(.\\{40,\\}\\) \\(.+\\)")
(setf prev-rev (match-string 1))
(setf prev-file (magit-decode-git-path (match-string 2))))
((looking-at "^\\([^ ]+\\) \\(.+\\)")
(push (cons (match-string 1)
(match-string 2)) revinfo)))
(forward-line)))
(when (and (eq type 'removal) prev-rev)
(cl-rotatef orig-rev prev-rev)
(cl-rotatef orig-file prev-file)
(setq revinfo nil)))
(list chunk revinfo)))
(defun magit-blame--commit-alist (rev)
(cl-mapcar 'cons
'("summary"
"author" "author-time" "author-tz"
"committer" "committer-time" "committer-tz")
(split-string (magit-rev-format "%s\v%an\v%ad\v%cn\v%cd" rev
"--date=format:%s\v%z")
"\v")))
(defun magit-blame-assert-buffer (process)
(unless (buffer-live-p (process-get process 'command-buf))
(kill-process process)
(user-error "Buffer being blamed has been killed")))
;;; Display
(defun magit-blame--make-overlays (buf chunk revinfo)
(with-current-buffer buf
(save-excursion
(save-restriction
(widen)
(let* ((line (oref chunk final-line))
(beg (magit-blame--line-beginning-position line))
(end (magit-blame--line-beginning-position
(+ line (oref chunk num-lines))))
(before (magit-blame-chunk-at (1- beg))))
(when (and before
(equal (oref before orig-rev)
(oref chunk orig-rev)))
(setq beg (magit-blame--line-beginning-position
(oset chunk final-line (oref before final-line))))
(cl-incf (oref chunk num-lines)
(oref before num-lines)))
(magit-blame--remove-overlays beg end)
(when magit-blame--make-margin-overlays
(magit-blame--make-margin-overlays chunk revinfo beg end))
(magit-blame--make-heading-overlay chunk revinfo beg end)
(magit-blame--make-highlight-overlay chunk beg))))))
(defun magit-blame--line-beginning-position (line)
(save-excursion
(goto-char (point-min))
(forward-line (1- line))
(point)))
(defun magit-blame--make-margin-overlays (chunk revinfo _beg end)
(save-excursion
(let ((line 0))
(while (< (point) end)
(magit-blame--make-margin-overlay chunk revinfo line)
(forward-line)
(cl-incf line)))))
(defun magit-blame--make-margin-overlay (chunk revinfo line)
(let* ((end (line-end-position))
;; If possible avoid putting this on the first character
;; of the line to avoid a conflict with the line overlay.
(beg (min (1+ (line-beginning-position)) end))
(ov (make-overlay beg end)))
(overlay-put ov 'magit-blame-chunk chunk)
(overlay-put ov 'magit-blame-revinfo revinfo)
(overlay-put ov 'magit-blame-margin line)
(magit-blame--update-margin-overlay ov)))
(defun magit-blame--make-heading-overlay (chunk revinfo beg end)
(let ((ov (make-overlay beg end)))
(overlay-put ov 'magit-blame-chunk chunk)
(overlay-put ov 'magit-blame-revinfo revinfo)
(overlay-put ov 'magit-blame-heading t)
(magit-blame--update-heading-overlay ov)))
(defun magit-blame--make-highlight-overlay (chunk beg)
(let ((ov (make-overlay beg (save-excursion
(goto-char beg)
(1+ (line-end-position))))))
(overlay-put ov 'magit-blame-chunk chunk)
(overlay-put ov 'magit-blame-highlight t)
(magit-blame--update-highlight-overlay ov)))
(defun magit-blame--update-margin ()
(setq left-margin-width (or (magit-blame--style-get 'margin-width) 0))
(set-window-buffer (selected-window) (current-buffer)))
(defun magit-blame--update-overlays ()
(save-restriction
(widen)
(dolist (ov (overlays-in (point-min) (point-max)))
(cond ((overlay-get ov 'magit-blame-heading)
(magit-blame--update-heading-overlay ov))
((overlay-get ov 'magit-blame-margin)
(magit-blame--update-margin-overlay ov))
((overlay-get ov 'magit-blame-highlight)
(magit-blame--update-highlight-overlay ov))))))
(defun magit-blame--update-margin-overlay (ov)
(overlay-put
ov 'before-string
(and (magit-blame--style-get 'margin-width)
(propertize
"o" 'display
(list (list 'margin 'left-margin)
(let ((line (overlay-get ov 'magit-blame-margin))
(format (magit-blame--style-get 'margin-format))
(face (magit-blame--style-get 'margin-face)))
(magit-blame--format-string
ov
(or (and (atom format)
format)
(nth line format)
(car (last format)))
(or (and (not (zerop line))
(magit-blame--style-get 'margin-body-face))
face
'magit-blame-margin))))))))
(defun magit-blame--update-heading-overlay (ov)
(overlay-put
ov 'before-string
(--if-let (magit-blame--style-get 'heading-format)
(magit-blame--format-string ov it 'magit-blame-heading)
(and (magit-blame--style-get 'show-lines)
(or (not (magit-blame--style-get 'margin-format))
(save-excursion
(goto-char (overlay-start ov))
;; Special case of the special case described in
;; `magit-blame--make-margin-overlay'. For empty
;; lines it is not possible to show both overlays
;; without the line being to high.
(not (= (point) (line-end-position)))))
magit-blame-separator))))
(defun magit-blame--update-highlight-overlay (ov)
(overlay-put ov 'font-lock-face (magit-blame--style-get 'highlight-face)))
(defun magit-blame--format-string (ov format face)
(let* ((chunk (overlay-get ov 'magit-blame-chunk))
(revinfo (overlay-get ov 'magit-blame-revinfo))
(key (list format face))
(string (cdr (assoc key revinfo))))
(unless string
(setq string
(and format
(magit-blame--format-string-1 (oref chunk orig-rev)
revinfo format face)))
(nconc revinfo (list (cons key string))))
string))
(defun magit-blame--format-string-1 (rev revinfo format face)
(let ((str
(if (string-match-p "\\`0\\{40,\\}\\'" rev)
(propertize (concat (if (string-prefix-p "\s" format) "\s" "")
"Not Yet Committed"
(if (string-suffix-p "\n" format) "\n" ""))
'font-lock-face face)
(magit--format-spec
(propertize format 'font-lock-face face)
(cl-flet* ((p0 (s f)
(propertize s 'font-lock-face
(if face
(if (listp face)
face
(list f face))
f)))
(p1 (k f)
(p0 (cdr (assoc k revinfo)) f))
(p2 (k1 k2 f)
(p0 (magit-blame--format-time-string
(cdr (assoc k1 revinfo))
(cdr (assoc k2 revinfo)))
f)))
`((?H . ,(p0 rev 'magit-blame-hash))
(?s . ,(p1 "summary" 'magit-blame-summary))
(?a . ,(p1 "author" 'magit-blame-name))
(?c . ,(p1 "committer" 'magit-blame-name))
(?A . ,(p2 "author-time" "author-tz" 'magit-blame-date))
(?C . ,(p2 "committer-time" "committer-tz" 'magit-blame-date))
(?f . "")))))))
(if-let ((width (and (string-suffix-p "%f" format)
(magit-blame--style-get 'margin-width))))
(concat str
(propertize (make-string (max 0 (- width (length str))) ?\s)
'font-lock-face face))
str)))
(defun magit-blame--format-separator ()
(propertize
(concat (propertize "\s" 'display '(space :height (2)))
(propertize "\n" 'line-height t))
'font-lock-face `(:background
,(face-attribute 'magit-blame-heading
:background nil t)
,@(and (>= emacs-major-version 27) '(:extend t)))))
(defun magit-blame--format-time-string (time tz)
(let* ((time-format (or (magit-blame--style-get 'time-format)
magit-blame-time-format))
(tz-in-second (and (string-search "%z" time-format)
(car (last (parse-time-string tz))))))
(format-time-string time-format
(seconds-to-time (string-to-number time))
tz-in-second)))
(defun magit-blame--remove-overlays (&optional beg end)
(save-restriction
(widen)
(dolist (ov (overlays-in (or beg (point-min))
(or end (point-max))))
(when (overlay-get ov 'magit-blame-chunk)
(delete-overlay ov)))))
(defun magit-blame-maybe-show-message ()
(when (magit-blame--style-get 'show-message)
(let ((message-log-max 0))
(if-let ((msg (cdr (assoc "summary"
(gethash (oref (magit-current-blame-chunk)
orig-rev)
magit-blame-cache)))))
(progn (set-text-properties 0 (length msg) nil msg)
(message msg))
(message "Commit data not available yet. Still blaming.")))))
;;; Commands
;;;###autoload (autoload 'magit-blame-echo "magit-blame" nil t)
(transient-define-suffix magit-blame-echo (args)
"For each line show the revision in which it was added.
Show the information about the chunk at point in the echo area
when moving between chunks. Unlike other blaming commands, do
not turn on `read-only-mode'."
:if (lambda ()
(and buffer-file-name
(or (not magit-blame-mode)
buffer-read-only)))
(interactive (list (magit-blame-arguments)))
(when magit-buffer-file-name
(user-error "Blob buffers aren't supported"))
(setq-local magit-blame--style
(assq magit-blame-echo-style magit-blame-styles))
(setq-local magit-blame-disable-modes
(cons 'eldoc-mode magit-blame-disable-modes))
(if (not magit-blame-mode)
(let ((magit-blame-read-only nil))
(magit-blame--pre-blame-assert 'addition)
(magit-blame--pre-blame-setup 'addition)
(magit-blame--run args))
(read-only-mode -1)
(magit-blame--update-overlays)))
;;;###autoload (autoload 'magit-blame-addition "magit-blame" nil t)
(transient-define-suffix magit-blame-addition (args)
"For each line show the revision in which it was added."
(interactive (list (magit-blame-arguments)))
(magit-blame--pre-blame-assert 'addition)
(magit-blame--pre-blame-setup 'addition)
(magit-blame--run args))
;;;###autoload (autoload 'magit-blame-removal "magit-blame" nil t)
(transient-define-suffix magit-blame-removal (args)
"For each line show the revision in which it was removed."
:if-nil 'buffer-file-name
(interactive (list (magit-blame-arguments)))
(unless magit-buffer-file-name
(user-error "Only blob buffers can be blamed in reverse"))
(magit-blame--pre-blame-assert 'removal)
(magit-blame--pre-blame-setup 'removal)
(magit-blame--run args))
;;;###autoload (autoload 'magit-blame-reverse "magit-blame" nil t)
(transient-define-suffix magit-blame-reverse (args)
"For each line show the last revision in which it still exists."
:if-nil 'buffer-file-name
(interactive (list (magit-blame-arguments)))
(unless magit-buffer-file-name
(user-error "Only blob buffers can be blamed in reverse"))
(magit-blame--pre-blame-assert 'final)
(magit-blame--pre-blame-setup 'final)
(magit-blame--run args))
(defun magit-blame--pre-blame-assert (type)
(unless (magit-toplevel)
(magit--not-inside-repository-error))
(if (and magit-blame-mode
(eq type magit-blame-type))
(if-let ((chunk (magit-current-blame-chunk)))
(unless (oref chunk prev-rev)
(user-error "Chunk has no further history"))
(user-error "Commit data not available yet. Still blaming."))
(unless (magit-file-relative-name nil (not magit-buffer-file-name))
(if buffer-file-name
(user-error "Buffer isn't visiting a tracked file")
(user-error "Buffer isn't visiting a file")))))
(defun magit-blame--pre-blame-setup (type)
(when magit-blame-mode
(if (eq type magit-blame-type)
(let ((style magit-blame--style))
(magit-blame-visit-other-file)
(setq-local magit-blame--style style)
(setq-local magit-blame-recursive-p t)
;; Set window-start for the benefit of quickstart.
(redisplay))
(magit-blame--remove-overlays)))
(setq magit-blame-type type))
(defun magit-blame-visit-other-file ()
"Visit another blob related to the current chunk."
(interactive)
(with-slots (prev-rev prev-file orig-line)
(magit-current-blame-chunk)
(unless prev-rev
(user-error "Chunk has no further history"))
(magit-with-toplevel
(magit-find-file prev-rev prev-file))
;; TODO Adjust line like magit-diff-visit-file.
(goto-char (point-min))
(forward-line (1- orig-line))))
(defun magit-blame-visit-file ()
"Visit the blob related to the current chunk."
(interactive)
(with-slots (orig-rev orig-file orig-line)
(magit-current-blame-chunk)
(magit-with-toplevel
(magit-find-file orig-rev orig-file))
(goto-char (point-min))
(forward-line (1- orig-line))))
(transient-define-suffix magit-blame-quit ()
"Turn off Magit-Blame mode.
If the buffer was created during a recursive blame,
then also kill the buffer."
:if-non-nil 'magit-blame-mode
(interactive)
(magit-blame-mode -1)
(when magit-blame-recursive-p
(kill-buffer)))
(defun magit-blame-next-chunk ()
"Move to the next chunk."
(interactive)
(--if-let (next-single-char-property-change (point) 'magit-blame-chunk)
(goto-char it)
(user-error "No more chunks")))
(defun magit-blame-previous-chunk ()
"Move to the previous chunk."
(interactive)
(--if-let (previous-single-char-property-change (point) 'magit-blame-chunk)
(goto-char it)
(user-error "No more chunks")))
(defun magit-blame-next-chunk-same-commit (&optional previous)
"Move to the next chunk from the same commit.\n\n(fn)"
(interactive)
(if-let ((rev (oref (magit-current-blame-chunk) orig-rev)))
(let ((pos (point)) ov)
(save-excursion
(while (and (not ov)
(not (= pos (if previous (point-min) (point-max))))
(setq pos (funcall
(if previous
#'previous-single-char-property-change
#'next-single-char-property-change)
pos 'magit-blame-chunk)))
(--when-let (magit-blame--overlay-at pos)
(when (equal (oref (magit-blame-chunk-at pos) orig-rev) rev)
(setq ov it)))))
(if ov
(goto-char (overlay-start ov))
(user-error "No more chunks from same commit")))
(user-error "This chunk hasn't been blamed yet")))
(defun magit-blame-previous-chunk-same-commit ()
"Move to the previous chunk from the same commit."
(interactive)
(magit-blame-next-chunk-same-commit #'previous-single-char-property-change))
(defun magit-blame-cycle-style ()
"Change how blame information is visualized.
Cycle through the elements of option `magit-blame-styles'."
(interactive)
(setq magit-blame--style
(or (cadr (cl-member (car magit-blame--style)
magit-blame-styles :key #'car))
(car magit-blame-styles)))
(magit-blame--update-margin)
(magit-blame--update-overlays))
(defun magit-blame-copy-hash ()
"Save hash of the current chunk's commit to the kill ring.
When the region is active, then save the region's content
instead of the hash, like `kill-ring-save' would."
(interactive)
(if (use-region-p)
(call-interactively #'copy-region-as-kill)
(kill-new (message "%s" (oref (magit-current-blame-chunk) orig-rev)))))
;;; Popup
;;;###autoload (autoload 'magit-blame "magit-blame" nil t)
(transient-define-prefix magit-blame ()
"Show the commits that added or removed lines in the visited file."
:man-page "git-blame"
:value '("-w")
["Arguments"
("-w" "Ignore whitespace" "-w")
("-r" "Do not treat root commits as boundaries" "--root")
("-P" "Follow only first parent" "--first-parent")
(magit-blame:-M)
(magit-blame:-C)]
["Actions"
("b" "Show commits adding lines" magit-blame-addition)
("r" "Show commits removing lines" magit-blame-removal)
("f" "Show last commits that still have lines" magit-blame-reverse)
("m" "Blame echo" magit-blame-echo)
("q" "Quit blaming" magit-blame-quit)]
["Refresh"
:if-non-nil magit-blame-mode
("c" "Cycle style" magit-blame-cycle-style :transient t)])
(defun magit-blame-arguments ()
(transient-args 'magit-blame))
(transient-define-argument magit-blame:-M ()
:description "Detect lines moved or copied within a file"
:class 'transient-option
:argument "-M"
:allow-empty t
:reader #'transient-read-number-N+)
(transient-define-argument magit-blame:-C ()
:description "Detect lines moved or copied between files"
:class 'transient-option
:argument "-C"
:allow-empty t
:reader #'transient-read-number-N+)
;;; Utilities
(defun magit-blame-maybe-update-revision-buffer ()
(when-let* ((chunk (magit-current-blame-chunk))
(commit (oref chunk orig-rev))
(buffer (magit-get-mode-buffer 'magit-revision-mode nil t)))
(if magit--update-revision-buffer
(setq magit--update-revision-buffer (list commit buffer))
(setq magit--update-revision-buffer (list commit buffer))
(run-with-idle-timer
magit-update-other-window-delay nil
(lambda ()
(pcase-let ((`(,rev ,buf) magit--update-revision-buffer))
(setq magit--update-revision-buffer nil)
(when (buffer-live-p buf)
(let ((magit-display-buffer-noselect t))
(apply #'magit-show-commit rev
(magit-diff-arguments 'magit-revision-mode))))))))))
;;; _
(provide 'magit-blame)
;;; magit-blame.el ends here

205
code/elpa/magit-20220425.1153/magit-bookmark.el Normal file
View file

@ -0,0 +1,205 @@
;;; magit-bookmark.el --- Bookmark support for Magit -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Inspired by an earlier implementation by Yuri Khan.
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Support for bookmarks for most Magit buffers.
;;; Code:
(require 'magit)
(require 'bookmark)
;;; Core
(defun magit--make-bookmark ()
"Create a bookmark for the current Magit buffer.
Input values are the major-mode's `magit-bookmark-name' method,
and the buffer-local values of the variables referenced in its
`magit-bookmark-variables' property."
(if (plist-member (symbol-plist major-mode) 'magit-bookmark-variables)
;; `bookmark-make-record-default's return value does not match
;; (NAME . ALIST), even though it is used as the default value
;; of `bookmark-make-record-function', which states that such
;; functions must do that. See #4356.
(let ((bookmark (cons nil (bookmark-make-record-default 'no-file))))
(bookmark-prop-set bookmark 'handler #'magit--handle-bookmark)
(bookmark-prop-set bookmark 'mode major-mode)
(bookmark-prop-set bookmark 'filename (magit-toplevel))
(bookmark-prop-set bookmark 'defaults (list (magit-bookmark-name)))
(dolist (var (get major-mode 'magit-bookmark-variables))
(bookmark-prop-set bookmark var (symbol-value var)))
(bookmark-prop-set
bookmark 'magit-hidden-sections
(--keep (and (oref it hidden)
(cons (oref it type)
(if (derived-mode-p 'magit-stash-mode)
(string-replace magit-buffer-revision
magit-buffer-revision-hash
(oref it value))
(oref it value))))
(oref magit-root-section children)))
bookmark)
(user-error "Bookmarking is not implemented for %s buffers" major-mode)))
;;;###autoload
(defun magit--handle-bookmark (bookmark)
"Open a bookmark created by `magit--make-bookmark'.
Call the `magit-*-setup-buffer' function of the the major-mode
with the variables' values as arguments, which were recorded by
`magit--make-bookmark'. Ignore `magit-display-buffer-function'."
(let ((buffer (let ((default-directory (bookmark-get-filename bookmark))
(mode (bookmark-prop-get bookmark 'mode))
(magit-display-buffer-function #'identity)
(magit-display-buffer-noselect t))
(apply (intern (format "%s-setup-buffer"
(substring (symbol-name mode) 0 -5)))
(--map (bookmark-prop-get bookmark it)
(get mode 'magit-bookmark-variables))))))
(set-buffer buffer) ; That is the interface we have to adhere to.
(when-let ((hidden (bookmark-prop-get bookmark 'magit-hidden-sections)))
(with-current-buffer buffer
(dolist (child (oref magit-root-section children))
(if (member (cons (oref child type)
(oref child value))
hidden)
(magit-section-hide child)
(magit-section-show child)))))
;; Compatibility with `bookmark+' package. See #4356.
(when (bound-and-true-p bmkp-jump-display-function)
(funcall bmkp-jump-display-function (current-buffer)))
nil))
(cl-defgeneric magit-bookmark-name ()
"Return name for bookmark to current buffer."
(format "%s%s"
(substring (symbol-name major-mode) 0 -5)
(if-let ((vars (get major-mode 'magit-bookmark-variables)))
(cl-mapcan (lambda (var)
(let ((val (symbol-value var)))
(if (and val (atom val))
(list val)
val)))
vars)
"")))
;;; Diff
;;;; Diff
(put 'magit-diff-mode 'magit-bookmark-variables
'(magit-buffer-range-hashed
magit-buffer-typearg
magit-buffer-diff-args
magit-buffer-diff-files))
(cl-defmethod magit-bookmark-name (&context (major-mode magit-diff-mode))
(format "magit-diff(%s%s)"
(pcase (magit-diff-type)
('staged "staged")
('unstaged "unstaged")
('committed magit-buffer-range)
('undefined
(delq nil (list magit-buffer-typearg magit-buffer-range-hashed))))
(if magit-buffer-diff-files
(concat " -- " (mapconcat #'identity magit-buffer-diff-files " "))
"")))
;;;; Revision
(put 'magit-revision-mode 'magit-bookmark-variables
'(magit-buffer-revision-hash
magit-buffer-diff-args
magit-buffer-diff-files))
(cl-defmethod magit-bookmark-name (&context (major-mode magit-revision-mode))
(format "magit-revision(%s %s)"
(magit-rev-abbrev magit-buffer-revision)
(if magit-buffer-diff-files
(mapconcat #'identity magit-buffer-diff-files " ")
(magit-rev-format "%s" magit-buffer-revision))))
;;;; Stash
(put 'magit-stash-mode 'magit-bookmark-variables
'(magit-buffer-revision-hash
magit-buffer-diff-args
magit-buffer-diff-files))
(cl-defmethod magit-bookmark-name (&context (major-mode magit-stash-mode))
(format "magit-stash(%s %s)"
(magit-rev-abbrev magit-buffer-revision)
(if magit-buffer-diff-files
(mapconcat #'identity magit-buffer-diff-files " ")
(magit-rev-format "%s" magit-buffer-revision))))
;;; Log
;;;; Log
(put 'magit-log-mode 'magit-bookmark-variables
'(magit-buffer-revisions
magit-buffer-log-args
magit-buffer-log-files))
(cl-defmethod magit-bookmark-name (&context (major-mode magit-log-mode))
(format "magit-log(%s%s)"
(mapconcat #'identity magit-buffer-revisions " ")
(if magit-buffer-log-files
(concat " -- " (mapconcat #'identity magit-buffer-log-files " "))
"")))
;;;; Cherry
(put 'magit-cherry-mode 'magit-bookmark-variables
'(magit-buffer-refname
magit-buffer-upstream))
(cl-defmethod magit-bookmark-name (&context (major-mode magit-cherry-mode))
(format "magit-cherry(%s > %s)"
magit-buffer-refname
magit-buffer-upstream))
;;;; Reflog
(put 'magit-reflog-mode 'magit-bookmark-variables
'(magit-buffer-refname))
(cl-defmethod magit-bookmark-name (&context (major-mode magit-reflog-mode))
(format "magit-reflog(%s)" magit-buffer-refname))
;;; Misc
(put 'magit-status-mode 'magit-bookmark-variables nil)
(put 'magit-refs-mode 'magit-bookmark-variables
'(magit-buffer-upstream
magit-buffer-arguments))
(put 'magit-stashes-mode 'magit-bookmark-variables nil)
(cl-defmethod magit-bookmark-name (&context (major-mode magit-stashes-mode))
(format "magit-states(%s)" magit-buffer-refname))
;;; _
(provide 'magit-bookmark)
;;; magit-bookmark.el ends here

934
code/elpa/magit-20220425.1153/magit-branch.el Normal file
View file

@ -0,0 +1,934 @@
;;; magit-branch.el --- Branch support -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library implements support for branches. It defines commands
;; for creating, checking out, manipulating, and configuring branches.
;; Commands defined here are mainly concerned with branches as
;; pointers, commands that deal with what a branch points at, are
;; defined elsewhere.
;;; Code:
(require 'magit)
(require 'magit-reset)
;;; Options
(defcustom magit-branch-read-upstream-first t
"Whether to read upstream before name of new branch when creating a branch.
`nil' Read the branch name first.
`t' Read the upstream first.
`fallback' Read the upstream first, but if it turns out that the chosen
value is not a valid upstream (because it cannot be resolved
as an existing revision), then treat it as the name of the
new branch and continue by reading the upstream next."
:package-version '(magit . "2.2.0")
:group 'magit-commands
:type '(choice (const :tag "read branch name first" nil)
(const :tag "read upstream first" t)
(const :tag "read upstream first, with fallback" fallback)))
(defcustom magit-branch-prefer-remote-upstream nil
"Whether to favor remote upstreams when creating new branches.
When a new branch is created, then the branch, commit, or stash
at point is suggested as the default starting point of the new
branch, or if there is no such revision at point the current
branch. In either case the user may choose another starting
point.
If the chosen starting point is a branch, then it may also be set
as the upstream of the new branch, depending on the value of the
Git variable `branch.autoSetupMerge'. By default this is done
for remote branches, but not for local branches.
You might prefer to always use some remote branch as upstream.
If the chosen starting point is (1) a local branch, (2) whose
name matches a member of the value of this option, (3) the
upstream of that local branch is a remote branch with the same
name, and (4) that remote branch can be fast-forwarded to the
local branch, then the chosen branch is used as starting point,
but its own upstream is used as the upstream of the new branch.
Members of this option's value are treated as branch names that
have to match exactly unless they contain a character that makes
them invalid as a branch name. Recommended characters to use
to trigger interpretation as a regexp are \"*\" and \"^\". Some
other characters which you might expect to be invalid, actually
are not, e.g. \".+$\" are all perfectly valid. More precisely,
if `git check-ref-format --branch STRING' exits with a non-zero
status, then treat STRING as a regexp.
Assuming the chosen branch matches these conditions you would end
up with with e.g.:
feature --upstream--> origin/master
instead of
feature --upstream--> master --upstream--> origin/master
Which you prefer is a matter of personal preference. If you do
prefer the former, then you should add branches such as \"master\",
\"next\", and \"maint\" to the value of this options."
:package-version '(magit . "2.4.0")
:group 'magit-commands
:type '(repeat string))
(defcustom magit-branch-adjust-remote-upstream-alist nil
"Alist of upstreams to be used when branching from remote branches.
When creating a local branch from an ephemeral branch located
on a remote, e.g. a feature or hotfix branch, then that remote
branch should usually not be used as the upstream branch, since
the push-remote already allows accessing it and having both the
upstream and the push-remote reference the same related branch
would be wasteful. Instead a branch like \"maint\" or \"master\"
should be used as the upstream.
This option allows specifying the branch that should be used as
the upstream when branching certain remote branches. The value
is an alist of the form ((UPSTREAM . RULE)...). The first
element is used whose UPSTREAM exists and whose RULE matches
the name of the new branch. Subsequent elements are ignored.
UPSTREAM is the branch to be used as the upstream for branches
specified by RULE. It can be a local or a remote branch.
RULE can either be a regular expression, matching branches whose
upstream should be the one specified by UPSTREAM. Or it can be
a list of the only branches that should *not* use UPSTREAM; all
other branches will. Matching is done after stripping the remote
part of the name of the branch that is being branched from.
If you use a finite set of non-ephemeral branches across all your
repositories, then you might use something like:
((\"origin/master\" . (\"master\" \"next\" \"maint\")))
Or if the names of all your ephemeral branches contain a slash,
at least in some repositories, then a good value could be:
((\"origin/master\" . \"/\"))
Of course you can also fine-tune:
((\"origin/maint\" . \"\\\\\\=`hotfix/\")
(\"origin/master\" . \"\\\\\\=`feature/\"))
UPSTREAM can be a local branch:
((\"master\" . (\"master\" \"next\" \"maint\")))
Because the main branch is no longer almost always named \"master\"
you should also account for other common names:
((\"main\" . (\"main\" \"master\" \"next\" \"maint\"))
(\"master\" . (\"main\" \"master\" \"next\" \"maint\")))
If you use remote branches as UPSTREAM, then you might also want
to set `magit-branch-prefer-remote-upstream' to a non-nil value.
However, I recommend that you use local branches as UPSTREAM."
:package-version '(magit . "2.9.0")
:group 'magit-commands
:type '(repeat (cons (string :tag "Use upstream")
(choice :tag "for branches"
(regexp :tag "matching")
(repeat :tag "except"
(string :tag "branch"))))))
(defcustom magit-branch-rename-push-target t
"Whether the push-remote setup is preserved when renaming a branch.
The command `magit-branch-rename' renames a branch named OLD to
NEW. This option controls how much of the push-remote setup is
preserved when doing so.
When nil, then preserve nothing and unset `branch.OLD.pushRemote'.
When `local-only', then first set `branch.NEW.pushRemote' to the
same value as `branch.OLD.pushRemote', provided the latter is
actually set and unless the former already has another value.
When t, then rename the branch named OLD on the remote specified
by `branch.OLD.pushRemote' to NEW, provided OLD exists on that
remote and unless NEW already exists on the remote.
When `forge-only' and the `forge' package is available, then
behave like `t' if the remote points to a repository on a forge
(currently Github or Gitlab), otherwise like `local-only'.
Another supported but obsolete value is `github-only'. It is a
misnomer because it now treated as an alias for `forge-only'."
:package-version '(magit . "2.90.0")
:group 'magit-commands
:type '(choice
(const :tag "Don't preserve push-remote setup" nil)
(const :tag "Preserve push-remote setup" local-only)
(const :tag "... and rename corresponding branch on remote" t)
(const :tag "... but only if remote is on a forge" forge-only)))
(defcustom magit-branch-direct-configure t
"Whether the command `magit-branch' shows Git variables.
When set to nil, no variables are displayed by this transient
command, instead the sub-transient `magit-branch-configure'
has to be used to view and change branch related variables."
:package-version '(magit . "2.7.0")
:group 'magit-commands
:type 'boolean)
(defcustom magit-published-branches '("origin/master")
"List of branches that are considered to be published."
:package-version '(magit . "2.13.0")
:group 'magit-commands
:type '(repeat string))
;;; Commands
;;;###autoload (autoload 'magit-branch "magit" nil t)
(transient-define-prefix magit-branch (branch)
"Add, configure or remove a branch."
:man-page "git-branch"
["Arguments"
(7 "-r" "Recurse submodules when checking out an existing branch"
"--recurse-submodules"
:if (lambda () (magit-git-version>= "2.13")))]
["Variables"
:if (lambda ()
(and magit-branch-direct-configure
(oref transient--prefix scope)))
("d" magit-branch.<branch>.description)
("u" magit-branch.<branch>.merge/remote)
("r" magit-branch.<branch>.rebase)
("p" magit-branch.<branch>.pushRemote)]
[["Checkout"
("b" "branch/revision" magit-checkout)
("l" "local branch" magit-branch-checkout)
(6 "o" "new orphan" magit-branch-orphan)]
[""
("c" "new branch" magit-branch-and-checkout)
("s" "new spin-off" magit-branch-spinoff)
(5 "w" "new worktree" magit-worktree-checkout)]
["Create"
("n" "new branch" magit-branch-create)
("S" "new spin-out" magit-branch-spinout)
(5 "W" "new worktree" magit-worktree-branch)]
["Do"
("C" "configure..." magit-branch-configure)
("m" "rename" magit-branch-rename)
("x" "reset" magit-branch-reset)
("k" "delete" magit-branch-delete)]
[""
(7 "h" "shelve" magit-branch-shelve)
(7 "H" "unshelve" magit-branch-unshelve)]]
(interactive (list (magit-get-current-branch)))
(transient-setup 'magit-branch nil nil :scope branch))
(defun magit-branch-arguments ()
(transient-args 'magit-branch))
;;;###autoload
(defun magit-checkout (revision &optional args)
"Checkout REVISION, updating the index and the working tree.
If REVISION is a local branch, then that becomes the current
branch. If it is something else, then `HEAD' becomes detached.
Checkout fails if the working tree or the staging area contain
changes.
\n(git checkout REVISION)."
(interactive (list (magit-read-other-branch-or-commit "Checkout")
(magit-branch-arguments)))
(when (string-match "\\`heads/\\(.+\\)" revision)
(setq revision (match-string 1 revision)))
(magit-run-git "checkout" args revision))
;;;###autoload
(defun magit-branch-create (branch start-point)
"Create BRANCH at branch or revision START-POINT."
(interactive (magit-branch-read-args "Create branch"))
(magit-call-git "branch" branch start-point)
(magit-branch-maybe-adjust-upstream branch start-point)
(magit-refresh))
;;;###autoload
(defun magit-branch-and-checkout (branch start-point &optional args)
"Create and checkout BRANCH at branch or revision START-POINT."
(interactive (append (magit-branch-read-args "Create and checkout branch")
(list (magit-branch-arguments))))
(if (string-match-p "^stash@{[0-9]+}$" start-point)
(magit-run-git "stash" "branch" branch start-point)
(magit-call-git "checkout" args "-b" branch start-point)
(magit-branch-maybe-adjust-upstream branch start-point)
(magit-refresh)))
;;;###autoload
(defun magit-branch-or-checkout (arg &optional start-point)
"Hybrid between `magit-checkout' and `magit-branch-and-checkout'.
Ask the user for an existing branch or revision. If the user
input actually can be resolved as a branch or revision, then
check that out, just like `magit-checkout' would.
Otherwise create and checkout a new branch using the input as
its name. Before doing so read the starting-point for the new
branch. This is similar to what `magit-branch-and-checkout'
does."
(interactive
(let ((arg (magit-read-other-branch-or-commit "Checkout")))
(list arg
(and (not (magit-commit-p arg))
(magit-read-starting-point "Create and checkout branch" arg)))))
(when (string-match "\\`heads/\\(.+\\)" arg)
(setq arg (match-string 1 arg)))
(if start-point
(magit-branch-and-checkout arg start-point)
(magit-checkout arg)))
;;;###autoload
(defun magit-branch-checkout (branch &optional start-point)
"Checkout an existing or new local branch.
Read a branch name from the user offering all local branches and
a subset of remote branches as candidates. Omit remote branches
for which a local branch by the same name exists from the list
of candidates. The user can also enter a completely new branch
name.
- If the user selects an existing local branch, then check that
out.
- If the user selects a remote branch, then create and checkout
a new local branch with the same name. Configure the selected
remote branch as push target.
- If the user enters a new branch name, then create and check
that out, after also reading the starting-point from the user.
In the latter two cases the upstream is also set. Whether it is
set to the chosen START-POINT or something else depends on the
value of `magit-branch-adjust-remote-upstream-alist', just like
when using `magit-branch-and-checkout'."
(interactive
(let* ((current (magit-get-current-branch))
(local (magit-list-local-branch-names))
(remote (--filter (and (string-match "[^/]+/" it)
(not (member (substring it (match-end 0))
(cons "HEAD" local))))
(magit-list-remote-branch-names)))
(choices (nconc (delete current local) remote))
(atpoint (magit-branch-at-point))
(choice (magit-completing-read
"Checkout branch" choices
nil nil nil 'magit-revision-history
(or (car (member atpoint choices))
(and atpoint
(car (member (and (string-match "[^/]+/" atpoint)
(substring atpoint (match-end 0)))
choices)))))))
(cond ((member choice remote)
(list (and (string-match "[^/]+/" choice)
(substring choice (match-end 0)))
choice))
((member choice local)
(list choice))
(t
(list choice (magit-read-starting-point "Create" choice))))))
(if (not start-point)
(magit-checkout branch (magit-branch-arguments))
(when (magit-anything-modified-p t)
(user-error "Cannot checkout when there are uncommitted changes"))
(let ((magit-inhibit-refresh t))
(magit-branch-and-checkout branch start-point))
(when (magit-remote-branch-p start-point)
(pcase-let ((`(,remote . ,remote-branch)
(magit-split-branch-name start-point)))
(when (and (equal branch remote-branch)
(not (equal remote (magit-get "remote.pushDefault"))))
(magit-set remote "branch" branch "pushRemote"))))
(magit-refresh)))
(defun magit-branch-maybe-adjust-upstream (branch start-point)
(--when-let
(or (and (magit-get-upstream-branch branch)
(magit-get-indirect-upstream-branch start-point))
(and (magit-remote-branch-p start-point)
(let ((name (cdr (magit-split-branch-name start-point))))
(-some (pcase-lambda (`(,upstream . ,rule))
(and (magit-branch-p upstream)
(if (listp rule)
(not (member name rule))
(string-match-p rule name))
upstream))
magit-branch-adjust-remote-upstream-alist))))
(magit-call-git "branch" (concat "--set-upstream-to=" it) branch)))
;;;###autoload
(defun magit-branch-orphan (branch start-point)
"Create and checkout an orphan BRANCH with contents from revision START-POINT."
(interactive (magit-branch-read-args "Create and checkout orphan branch"))
(magit-run-git "checkout" "--orphan" branch start-point))
(defun magit-branch-read-args (prompt &optional default-start)
(if magit-branch-read-upstream-first
(let ((choice (magit-read-starting-point prompt nil default-start)))
(if (magit-rev-verify choice)
(list (magit-read-string-ns
(if magit-completing-read--silent-default
(format "%s (starting at `%s')" prompt choice)
"Name for new branch")
(let ((def (mapconcat #'identity
(cdr (split-string choice "/"))
"/")))
(and (member choice (magit-list-remote-branch-names))
(not (member def (magit-list-local-branch-names)))
def)))
choice)
(if (eq magit-branch-read-upstream-first 'fallback)
(list choice
(magit-read-starting-point prompt choice default-start))
(user-error "Not a valid starting-point: %s" choice))))
(let ((branch (magit-read-string-ns (concat prompt " named"))))
(list branch (magit-read-starting-point prompt branch default-start)))))
;;;###autoload
(defun magit-branch-spinout (branch &optional from)
"Create new branch from the unpushed commits.
Like `magit-branch-spinoff' but remain on the current branch.
If there are any uncommitted changes, then behave exactly like
`magit-branch-spinoff'."
(interactive (list (magit-read-string-ns "Spin out branch")
(car (last (magit-region-values 'commit)))))
(magit--branch-spinoff branch from nil))
;;;###autoload
(defun magit-branch-spinoff (branch &optional from)
"Create new branch from the unpushed commits.
Create and checkout a new branch starting at and tracking the
current branch. That branch in turn is reset to the last commit
it shares with its upstream. If the current branch has no
upstream or no unpushed commits, then the new branch is created
anyway and the previously current branch is not touched.
This is useful to create a feature branch after work has already
began on the old branch (likely but not necessarily \"master\").
If the current branch is a member of the value of option
`magit-branch-prefer-remote-upstream' (which see), then the
current branch will be used as the starting point as usual, but
the upstream of the starting-point may be used as the upstream
of the new branch, instead of the starting-point itself.
If optional FROM is non-nil, then the source branch is reset
to `FROM~', instead of to the last commit it shares with its
upstream. Interactively, FROM is only ever non-nil, if the
region selects some commits, and among those commits, FROM is
the commit that is the fewest commits ahead of the source
branch.
The commit at the other end of the selection actually does not
matter, all commits between FROM and `HEAD' are moved to the new
branch. If FROM is not reachable from `HEAD' or is reachable
from the source branch's upstream, then an error is raised."
(interactive (list (magit-read-string-ns "Spin off branch")
(car (last (magit-region-values 'commit)))))
(magit--branch-spinoff branch from t))
(defun magit--branch-spinoff (branch from checkout)
(when (magit-branch-p branch)
(user-error "Cannot spin off %s. It already exists" branch))
(when (and (not checkout)
(magit-anything-modified-p))
(message "Staying on HEAD due to uncommitted changes")
(setq checkout t))
(if-let ((current (magit-get-current-branch)))
(let ((tracked (magit-get-upstream-branch current))
base)
(when from
(unless (magit-rev-ancestor-p from current)
(user-error "Cannot spin off %s. %s is not reachable from %s"
branch from current))
(when (and tracked
(magit-rev-ancestor-p from tracked))
(user-error "Cannot spin off %s. %s is ancestor of upstream %s"
branch from tracked)))
(let ((magit-process-raise-error t))
(if checkout
(magit-call-git "checkout" "-b" branch current)
(magit-call-git "branch" branch current)))
(--when-let (magit-get-indirect-upstream-branch current)
(magit-call-git "branch" "--set-upstream-to" it branch))
(when (and tracked
(setq base
(if from
(concat from "^")
(magit-git-string "merge-base" current tracked)))
(not (magit-rev-eq base current)))
(if checkout
(magit-call-git "update-ref" "-m"
(format "reset: moving to %s" base)
(concat "refs/heads/" current) base)
(magit-call-git "reset" "--hard" base))))
(if checkout
(magit-call-git "checkout" "-b" branch)
(magit-call-git "branch" branch)))
(magit-refresh))
;;;###autoload
(defun magit-branch-reset (branch to &optional set-upstream)
"Reset a branch to the tip of another branch or any other commit.
When the branch being reset is the current branch, then do a
hard reset. If there are any uncommitted changes, then the user
has to confirm the reset because those changes would be lost.
This is useful when you have started work on a feature branch but
realize it's all crap and want to start over.
When resetting to another branch and a prefix argument is used,
then also set the target branch as the upstream of the branch
that is being reset."
(interactive
(let* ((atpoint (magit-local-branch-at-point))
(branch (magit-read-local-branch "Reset branch" atpoint)))
(list branch
(magit-completing-read (format "Reset %s to" branch)
(delete branch (magit-list-branch-names))
nil nil nil 'magit-revision-history
(or (and (not (equal branch atpoint)) atpoint)
(magit-get-upstream-branch branch)))
current-prefix-arg)))
(let ((magit-inhibit-refresh t))
(if (equal branch (magit-get-current-branch))
(if (and (magit-anything-modified-p)
(not (yes-or-no-p
"Uncommitted changes will be lost. Proceed? ")))
(user-error "Abort")
(magit-reset-hard to))
(magit-call-git "update-ref"
"-m" (format "reset: moving to %s" to)
(magit-git-string "rev-parse" "--symbolic-full-name"
branch)
to))
(when (and set-upstream (magit-branch-p to))
(magit-set-upstream-branch branch to)
(magit-branch-maybe-adjust-upstream branch to)))
(magit-refresh))
(defvar magit-branch-delete-never-verify nil
"Whether `magit-branch-delete' always pushes with \"--no-verify\".")
;;;###autoload
(defun magit-branch-delete (branches &optional force)
"Delete one or multiple branches.
If the region marks multiple branches, then offer to delete
those, otherwise prompt for a single branch to be deleted,
defaulting to the branch at point."
;; One would expect this to be a command as simple as, for example,
;; `magit-branch-rename'; but it turns out everyone wants to squeeze
;; a bit of extra functionality into this one, including myself.
(interactive
(let ((branches (magit-region-values 'branch t))
(force current-prefix-arg))
(if (length> branches 1)
(magit-confirm t nil "Delete %i branches" nil branches)
(setq branches
(list (magit-read-branch-prefer-other
(if force "Force delete branch" "Delete branch")))))
(unless force
(when-let ((unmerged (-remove #'magit-branch-merged-p branches)))
(if (magit-confirm 'delete-unmerged-branch
"Delete unmerged branch %s"
"Delete %i unmerged branches"
'noabort unmerged)
(setq force branches)
(or (setq branches (-difference branches unmerged))
(user-error "Abort")))))
(list branches force)))
(let* ((refs (mapcar #'magit-ref-fullname branches))
(ambiguous (--remove it refs)))
(when ambiguous
(user-error
"%s ambiguous. Please cleanup using git directly."
(let ((len (length ambiguous)))
(cond
((= len 1)
(format "%s is" (-first #'magit-ref-ambiguous-p branches)))
((= len (length refs))
(format "These %s names are" len))
(t
(format "%s of these names are" len))))))
(cond
((string-match "^refs/remotes/\\([^/]+\\)" (car refs))
(let* ((remote (match-string 1 (car refs)))
(offset (1+ (length remote))))
(cond
((magit-confirm 'delete-branch-on-remote
"Delete %s on the remote (not just locally)"
"Delete %i branches on the remote (not just locally)"
'noabort branches)
;; The ref may actually point at another rev on the remote,
;; but this is better than nothing.
(dolist (ref refs)
(message "Delete %s (was %s)" ref
(magit-rev-parse "--short" ref)))
;; Assume the branches actually still exist on the remote.
(magit-run-git-async
"push"
(and (or force magit-branch-delete-never-verify) "--no-verify")
remote
(--map (concat ":" (substring it offset)) branches))
;; If that is not the case, then this deletes the tracking branches.
(set-process-sentinel
magit-this-process
(apply-partially #'magit-delete-remote-branch-sentinel remote refs)))
(t
(dolist (ref refs)
(message "Delete %s (was %s)" ref
(magit-rev-parse "--short" ref))
(magit-call-git "update-ref" "-d" ref))
(magit-refresh)))))
((length> branches 1)
(setq branches (delete (magit-get-current-branch) branches))
(mapc #'magit-branch-maybe-delete-pr-remote branches)
(mapc #'magit-branch-unset-pushRemote branches)
(magit-run-git "branch" (if force "-D" "-d") branches))
(t ; And now for something completely different.
(let* ((branch (car branches))
(prompt (format "Branch %s is checked out. " branch))
(target (magit-get-upstream-branch)))
(when (equal branch (magit-get-current-branch))
(when (or (equal branch target)
(not target))
(setq target (magit-main-branch)))
(pcase (if (or (equal branch target)
(not target))
(magit-read-char-case prompt nil
(?d "[d]etach HEAD & delete" 'detach)
(?a "[a]bort" 'abort))
(magit-read-char-case prompt nil
(?d "[d]etach HEAD & delete" 'detach)
(?c (format "[c]heckout %s & delete" target) 'target)
(?a "[a]bort" 'abort)))
(`detach (unless (or (equal force '(4))
(member branch force)
(magit-branch-merged-p branch t))
(magit-confirm 'delete-unmerged-branch
"Delete unmerged branch %s" ""
nil (list branch)))
(magit-call-git "checkout" "--detach"))
(`target (unless (or (equal force '(4))
(member branch force)
(magit-branch-merged-p branch target))
(magit-confirm 'delete-unmerged-branch
"Delete unmerged branch %s" ""
nil (list branch)))
(magit-call-git "checkout" target))
(`abort (user-error "Abort")))
(setq force t))
(magit-branch-maybe-delete-pr-remote branch)
(magit-branch-unset-pushRemote branch)
(magit-run-git "branch" (if force "-D" "-d") branch))))))
(put 'magit-branch-delete 'interactive-only t)
(defun magit-branch-maybe-delete-pr-remote (branch)
(when-let ((remote (magit-get "branch" branch "pullRequestRemote")))
(let* ((variable (format "remote.%s.fetch" remote))
(refspecs (magit-get-all variable)))
(unless (member (format "+refs/heads/*:refs/remotes/%s/*" remote)
refspecs)
(let ((refspec
(if (equal (magit-get "branch" branch "pushRemote") remote)
(format "+refs/heads/%s:refs/remotes/%s/%s"
branch remote branch)
(let ((merge (magit-get "branch" branch "merge")))
(and merge
(string-prefix-p "refs/heads/" merge)
(setq merge (substring merge 11))
(format "+refs/heads/%s:refs/remotes/%s/%s"
merge remote merge))))))
(when (member refspec refspecs)
(if (and (length= refspecs 1)
(magit-confirm 'delete-pr-remote
(format "Also delete remote %s (%s)" remote
"no pull-request branch remains")
nil t))
(magit-call-git "remote" "rm" remote)
(magit-call-git "config" "--unset-all" variable
(format "^%s$" (regexp-quote refspec))))))))))
(defun magit-branch-unset-pushRemote (branch)
(magit-set nil "branch" branch "pushRemote"))
(defun magit-delete-remote-branch-sentinel (remote refs process event)
(when (memq (process-status process) '(exit signal))
(if (= (process-exit-status process) 1)
(if-let ((on-remote (--map (concat "refs/remotes/" remote "/" it)
(magit-remote-list-branches remote)))
(rest (--filter (and (not (member it on-remote))
(magit-ref-exists-p it))
refs)))
(progn
(process-put process 'inhibit-refresh t)
(magit-process-sentinel process event)
(setq magit-this-error nil)
(message "Some remote branches no longer exist. %s"
"Deleting just the local tracking refs instead...")
(dolist (ref rest)
(magit-call-git "update-ref" "-d" ref))
(magit-refresh)
(message "Deleting local remote-tracking refs...done"))
(magit-process-sentinel process event))
(magit-process-sentinel process event))))
;;;###autoload
(defun magit-branch-rename (old new &optional force)
"Rename the branch named OLD to NEW.
With a prefix argument FORCE, rename even if a branch named NEW
already exists.
If `branch.OLD.pushRemote' is set, then unset it. Depending on
the value of `magit-branch-rename-push-target' (which see) maybe
set `branch.NEW.pushRemote' and maybe rename the push-target on
the remote."
(interactive
(let ((branch (magit-read-local-branch "Rename branch")))
(list branch
(magit-read-string-ns (format "Rename branch '%s' to" branch)
nil 'magit-revision-history)
current-prefix-arg)))
(when (string-match "\\`heads/\\(.+\\)" old)
(setq old (match-string 1 old)))
(when (equal old new)
(user-error "Old and new branch names are the same"))
(magit-call-git "branch" (if force "-M" "-m") old new)
(when magit-branch-rename-push-target
(let ((remote (magit-get-push-remote old))
(old-specified (magit-get "branch" old "pushRemote"))
(new-specified (magit-get "branch" new "pushRemote")))
(when (and old-specified (or force (not new-specified)))
;; Keep the target setting branch specified, even if that is
;; redundant. But if a branch by the same name existed before
;; and the rename isn't forced, then do not change a leftover
;; setting. Such a leftover setting may or may not conform to
;; what we expect here...
(magit-set old-specified "branch" new "pushRemote"))
(when (and (equal (magit-get-push-remote new) remote)
;; ...and if it does not, then we must abort.
(not (eq magit-branch-rename-push-target 'local-only))
(or (not (memq magit-branch-rename-push-target
'(forge-only github-only)))
(and (require (quote forge) nil t)
(fboundp 'forge--forge-remote-p)
(forge--forge-remote-p remote))))
(let ((old-target (magit-get-push-branch old t))
(new-target (magit-get-push-branch new t))
(remote (magit-get-push-remote new)))
(when (and old-target
(not new-target)
(magit-y-or-n-p (format "Also rename %S to %S on \"%s\""
old new remote)))
;; Rename on (i.e. within) the remote, but only if the
;; destination ref doesn't exist yet. If that ref already
;; exists, then it probably is of some value and we better
;; not touch it. Ignore what the local ref points at,
;; i.e. if the local and the remote ref didn't point at
;; the same commit before the rename then keep it that way.
(magit-call-git "push" "-v" remote
(format "%s:refs/heads/%s" old-target new)
(format ":refs/heads/%s" old)))))))
(magit-branch-unset-pushRemote old)
(magit-refresh))
;;;###autoload
(defun magit-branch-shelve (branch)
"Shelve a BRANCH.
Rename \"refs/heads/BRANCH\" to \"refs/shelved/BRANCH\",
and also rename the respective reflog file."
(interactive (list (magit-read-other-local-branch "Shelve branch")))
(let ((old (concat "refs/heads/" branch))
(new (concat "refs/shelved/" branch)))
(magit-git "update-ref" new old "")
(magit--rename-reflog-file old new)
(magit-branch-unset-pushRemote branch)
(magit-run-git "branch" "-D" branch)))
;;;###autoload
(defun magit-branch-unshelve (branch)
"Unshelve a BRANCH
Rename \"refs/shelved/BRANCH\" to \"refs/heads/BRANCH\",
and also rename the respective reflog file."
(interactive
(list (magit-completing-read
"Unshelve branch"
(--map (substring it 8)
(magit-list-refnames "refs/shelved"))
nil t)))
(let ((old (concat "refs/shelved/" branch))
(new (concat "refs/heads/" branch)))
(magit-git "update-ref" new old "")
(magit--rename-reflog-file old new)
(magit-run-git "update-ref" "-d" old)))
(defun magit--rename-reflog-file (old new)
(let ((old (magit-git-dir (concat "logs/" old)))
(new (magit-git-dir (concat "logs/" new))))
(when (file-exists-p old)
(make-directory (file-name-directory new) t)
(rename-file old new t))))
;;; Configure
;;;###autoload (autoload 'magit-branch-configure "magit-branch" nil t)
(transient-define-prefix magit-branch-configure (branch)
"Configure a branch."
:man-page "git-branch"
[:description
(lambda ()
(concat
(propertize "Configure " 'face 'transient-heading)
(propertize (oref transient--prefix scope) 'face 'magit-branch-local)))
("d" magit-branch.<branch>.description)
("u" magit-branch.<branch>.merge/remote)
("r" magit-branch.<branch>.rebase)
("p" magit-branch.<branch>.pushRemote)]
["Configure repository defaults"
("R" magit-pull.rebase)
("P" magit-remote.pushDefault)]
["Configure branch creation"
("a m" magit-branch.autoSetupMerge)
("a r" magit-branch.autoSetupRebase)]
(interactive
(list (or (and (not current-prefix-arg)
(not (and magit-branch-direct-configure
(eq transient-current-command 'magit-branch)))
(magit-get-current-branch))
(magit--read-branch-scope))))
(transient-setup 'magit-branch-configure nil nil :scope branch))
(defun magit--read-branch-scope (&optional obj)
(magit-read-local-branch
(if obj
(format "Set %s for branch"
(format (oref obj variable) "<name>"))
"Configure branch")))
(transient-define-suffix magit-branch.<branch>.description (branch)
"Edit the description of BRANCH."
:class 'magit--git-variable
:transient nil
:variable "branch.%s.description"
(interactive (list (oref transient-current-prefix scope)))
(magit-run-git-with-editor "branch" "--edit-description" branch))
(add-hook 'find-file-hook #'magit-branch-description-check-buffers)
(defun magit-branch-description-check-buffers ()
(and buffer-file-name
(string-match-p "/\\(BRANCH\\|EDIT\\)_DESCRIPTION\\'" buffer-file-name)))
(defclass magit--git-branch:upstream (magit--git-variable)
((format :initform " %k %m %M\n %r %R")))
(transient-define-infix magit-branch.<branch>.merge/remote ()
:class 'magit--git-branch:upstream)
(cl-defmethod transient-init-value ((obj magit--git-branch:upstream))
(when-let* ((branch (oref transient--prefix scope))
(remote (magit-get "branch" branch "remote"))
(merge (magit-get "branch" branch "merge")))
(oset obj value (list remote merge))))
(cl-defmethod transient-infix-read ((obj magit--git-branch:upstream))
(if (oref obj value)
(oset obj value nil)
(magit-read-upstream-branch (oref transient--prefix scope) "Upstream")))
(cl-defmethod transient-infix-set ((obj magit--git-branch:upstream) refname)
(magit-set-upstream-branch (oref transient--prefix scope) refname)
(oset obj value
(and-let* ((branch (oref transient--prefix scope))
(r (magit-get "branch" branch "remote"))
(m (magit-get "branch" branch "merge")))
(list r m)))
(magit-refresh))
(cl-defmethod transient-format ((obj magit--git-branch:upstream))
(let ((branch (oref transient--prefix scope)))
(format-spec
(oref obj format)
`((?k . ,(transient-format-key obj))
(?r . ,(format "branch.%s.remote" branch))
(?m . ,(format "branch.%s.merge" branch))
(?R . ,(transient-format-value obj #'car))
(?M . ,(transient-format-value obj #'cadr))))))
(cl-defmethod transient-format-value ((obj magit--git-branch:upstream) key)
(if-let ((value (funcall key (oref obj value))))
(propertize value 'face 'transient-argument)
(propertize "unset" 'face 'transient-inactive-argument)))
(transient-define-infix magit-branch.<branch>.rebase ()
:class 'magit--git-variable:choices
:scope #'magit--read-branch-scope
:variable "branch.%s.rebase"
:fallback "pull.rebase"
:choices '("true" "false")
:default "false")
(transient-define-infix magit-branch.<branch>.pushRemote ()
:class 'magit--git-variable:choices
:scope #'magit--read-branch-scope
:variable "branch.%s.pushRemote"
:fallback "remote.pushDefault"
:choices #'magit-list-remotes)
(transient-define-infix magit-pull.rebase ()
:class 'magit--git-variable:choices
:variable "pull.rebase"
:choices '("true" "false")
:default "false")
(transient-define-infix magit-remote.pushDefault ()
:class 'magit--git-variable:choices
:variable "remote.pushDefault"
:choices #'magit-list-remotes)
(transient-define-infix magit-branch.autoSetupMerge ()
:class 'magit--git-variable:choices
:variable "branch.autoSetupMerge"
:choices '("always" "true" "false")
:default "true")
(transient-define-infix magit-branch.autoSetupRebase ()
:class 'magit--git-variable:choices
:variable "branch.autoSetupRebase"
:choices '("always" "local" "remote" "never")
:default "never")
;;; _
(provide 'magit-branch)
;;; magit-branch.el ends here

132
code/elpa/magit-20220425.1153/magit-bundle.el Normal file
View file

@ -0,0 +1,132 @@
;;; magit-bundle.el --- Bundle support for Magit -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
(require 'magit)
;;; Commands
;;;###autoload (autoload 'magit-bundle "magit-bundle" nil t)
(transient-define-prefix magit-bundle ()
"Create or verify Git bundles."
:man-page "git-bundle"
["Actions"
("c" "create" magit-bundle-create)
("v" "verify" magit-bundle-verify)
("l" "list-heads" magit-bundle-list-heads)])
;;;###autoload (autoload 'magit-bundle-import "magit-bundle" nil t)
(transient-define-prefix magit-bundle-create (&optional file refs args)
"Create a bundle."
:man-page "git-bundle"
["Arguments"
("-a" "Include all refs" "--all")
("-b" "Include branches" "--branches=" :allow-empty t)
("-t" "Include tags" "--tags=" :allow-empty t)
("-r" "Include remotes" "--remotes=" :allow-empty t)
("-g" "Include refs" "--glob=")
("-e" "Exclude refs" "--exclude=")
(magit-log:-n)
(magit-log:--since)
(magit-log:--until)]
["Actions"
("c" "create regular bundle" magit-bundle-create)
("t" "create tracked bundle" magit-bundle-create-tracked)
("u" "update tracked bundle" magit-bundle-update-tracked)]
(interactive
(and (eq transient-current-command 'magit-bundle-create)
(list (read-file-name "Create bundle: " nil nil nil
(concat (file-name-nondirectory
(directory-file-name (magit-toplevel)))
".bundle"))
(magit-completing-read-multiple* "Refnames (zero or more): "
(magit-list-refnames))
(transient-args 'magit-bundle-create))))
(if file
(magit-git-bundle "create" file refs args)
(transient-setup 'magit-bundle-create)))
;;;###autoload
(defun magit-bundle-create-tracked (file tag branch refs args)
"Create and track a new bundle."
(interactive
(let ((tag (magit-read-tag "Track bundle using tag"))
(branch (magit-read-branch "Bundle branch"))
(refs (magit-completing-read-multiple*
"Additional refnames (zero or more): "
(magit-list-refnames))))
(list (read-file-name "File: " nil nil nil (concat tag ".bundle"))
tag branch
(if (equal branch (magit-get-current-branch))
(cons "HEAD" refs)
refs)
(transient-args 'magit-bundle-create))))
(magit-git-bundle "create" file (cons branch refs) args)
(magit-git "tag" "--force" tag branch
"-m" (concat ";; git-bundle tracking\n"
(pp-to-string `((file . ,file)
(branch . ,branch)
(refs . ,refs)
(args . ,args))))))
;;;###autoload
(defun magit-bundle-update-tracked (tag)
"Update a bundle that is being tracked using TAG."
(interactive (list (magit-read-tag "Update bundle tracked by tag" t)))
(let (msg)
(let-alist (magit--with-temp-process-buffer
(save-excursion
(magit-git-insert "for-each-ref" "--format=%(contents)"
(concat "refs/tags/" tag)))
(setq msg (buffer-string))
(ignore-errors (read (current-buffer))))
(unless (and .file .branch)
(error "Tag %s does not appear to track a bundle" tag))
(magit-git-bundle "create" .file
(cons (concat tag ".." .branch) .refs)
.args)
(magit-git "tag" "--force" tag .branch "-m" msg))))
;;;###autoload
(defun magit-bundle-verify (file)
"Check whether FILE is valid and applies to the current repository."
(interactive (list (magit-bundle--read-file-name "Verify bundle: ")))
(magit-process-buffer)
(magit-git-bundle "verify" file))
;;;###autoload
(defun magit-bundle-list-heads (file)
"List the refs in FILE."
(interactive (list (magit-bundle--read-file-name "List heads of bundle: ")))
(magit-process-buffer)
(magit-git-bundle "list-heads" file))
(defun magit-bundle--read-file-name (prompt)
(read-file-name prompt nil nil t (magit-file-at-point) #'file-regular-p))
(defun magit-git-bundle (command file &optional refs args)
(magit-git "bundle" command (magit-convert-filename-for-git file) refs args))
;;; _
(provide 'magit-bundle)
;;; magit-bundle.el ends here

327
code/elpa/magit-20220425.1153/magit-clone.el Normal file
View file

@ -0,0 +1,327 @@
;;; magit-clone.el --- Clone a repository -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library implements clone commands.
;;; Code:
(require 'magit)
;;; Options
(defcustom magit-clone-set-remote-head nil
"Whether cloning creates the symbolic-ref `<remote>/HEAD'."
:package-version '(magit . "2.4.2")
:group 'magit-commands
:type 'boolean)
(defcustom magit-clone-set-remote.pushDefault 'ask
"Whether to set the value of `remote.pushDefault' after cloning.
If t, then set without asking. If nil, then don't set. If
`ask', then ask."
:package-version '(magit . "2.4.0")
:group 'magit-commands
:type '(choice (const :tag "set" t)
(const :tag "ask" ask)
(const :tag "don't set" nil)))
(defcustom magit-clone-default-directory nil
"Default directory to use when `magit-clone' reads destination.
If nil (the default), then use the value of `default-directory'.
If a directory, then use that. If a function, then call that
with the remote url as only argument and use the returned value."
:package-version '(magit . "2.90.0")
:group 'magit-commands
:type '(choice (const :tag "value of default-directory")
(directory :tag "constant directory")
(function :tag "function's value")))
(defcustom magit-clone-always-transient nil
"Whether `magit-clone' always acts as a transient prefix command.
If nil, then a prefix argument has to be used to show the transient
popup instead of invoking the default suffix `magit-clone-regular'
directly."
:package-version '(magit . "3.0.0")
:group 'magit-commands
:type 'boolean)
(defcustom magit-clone-name-alist
'(("\\`\\(?:github:\\|gh:\\)?\\([^:]+\\)\\'" "github.com" "github.user")
("\\`\\(?:gitlab:\\|gl:\\)\\([^:]+\\)\\'" "gitlab.com" "gitlab.user"))
"Alist mapping repository names to repository urls.
Each element has the form (REGEXP HOSTNAME USER). When the user
enters a name when a cloning command asks for a name or url, then
that is looked up in this list. The first element whose REGEXP
matches is used.
The format specified by option `magit-clone-url-format' is used
to turn the name into an url, using HOSTNAME and the repository
name. If the provided name contains a slash, then that is used.
Otherwise if the name omits the owner of the repository, then the
default user specified in the matched entry is used.
If USER contains a dot, then it is treated as a Git variable and
the value of that is used as the username. Otherwise it is used
as the username itself."
:package-version '(magit . "3.0.0")
:group 'magit-commands
:type '(repeat (list regexp
(string :tag "hostname")
(string :tag "user name or git variable"))))
(defcustom magit-clone-url-format "git@%h:%n.git"
"Format used when turning repository names into urls.
%h is the hostname and %n is the repository name, including
the name of the owner. Also see `magit-clone-name-alist'."
:package-version '(magit . "3.0.0")
:group 'magit-commands
:type 'regexp)
;;; Commands
;;;###autoload (autoload 'magit-clone "magit-clone" nil t)
(transient-define-prefix magit-clone (&optional transient)
"Clone a repository."
:man-page "git-clone"
["Fetch arguments"
("-B" "Clone a single branch" "--single-branch")
("-n" "Do not clone tags" "--no-tags")
("-S" "Clones submodules" "--recurse-submodules" :level 6)
("-l" "Do not optimize" "--no-local" :level 7)]
["Setup arguments"
("-o" "Set name of remote" ("-o" "--origin="))
("-b" "Set HEAD branch" ("-b" "--branch="))
(magit-clone:--filter
:if (lambda () (magit-git-version>= "2.17.0"))
:level 7)
("-g" "Separate git directory" "--separate-git-dir="
transient-read-directory :level 7)
("-t" "Use template directory" "--template="
transient-read-existing-directory :level 6)]
["Local sharing arguments"
("-s" "Share objects" ("-s" "--shared" :level 7))
("-h" "Do not use hardlinks" "--no-hardlinks")]
["Clone"
("C" "regular" magit-clone-regular)
("s" "shallow" magit-clone-shallow)
("d" "shallow since date" magit-clone-shallow-since :level 7)
("e" "shallow excluding" magit-clone-shallow-exclude :level 7)
(">" "sparse checkout" magit-clone-sparse
:if (lambda () (magit-git-version>= "2.25.0"))
:level 6)
("b" "bare" magit-clone-bare)
("m" "mirror" magit-clone-mirror)]
(interactive (list (or magit-clone-always-transient current-prefix-arg)))
(if transient
(transient-setup 'magit-clone)
(call-interactively #'magit-clone-regular)))
(transient-define-argument magit-clone:--filter ()
:description "Filter some objects"
:class 'transient-option
:key "-f"
:argument "--filter="
:reader #'magit-clone-read-filter)
(defun magit-clone-read-filter (prompt initial-input history)
(magit-completing-read prompt
(list "blob:none" "tree:0")
nil nil initial-input history))
;;;###autoload
(defun magit-clone-regular (repository directory args)
"Create a clone of REPOSITORY in DIRECTORY.
Then show the status buffer for the new repository."
(interactive (magit-clone-read-args))
(magit-clone-internal repository directory args))
;;;###autoload
(defun magit-clone-shallow (repository directory args depth)
"Create a shallow clone of REPOSITORY in DIRECTORY.
Then show the status buffer for the new repository.
With a prefix argument read the DEPTH of the clone;
otherwise use 1."
(interactive (append (magit-clone-read-args)
(list (if current-prefix-arg
(read-number "Depth: " 1)
1))))
(magit-clone-internal repository directory
(cons (format "--depth=%s" depth) args)))
;;;###autoload
(defun magit-clone-shallow-since (repository directory args date)
"Create a shallow clone of REPOSITORY in DIRECTORY.
Then show the status buffer for the new repository.
Exclude commits before DATE, which is read from the
user."
(interactive (append (magit-clone-read-args)
(list (transient-read-date "Exclude commits before: "
nil nil))))
(magit-clone-internal repository directory
(cons (format "--shallow-since=%s" date) args)))
;;;###autoload
(defun magit-clone-shallow-exclude (repository directory args exclude)
"Create a shallow clone of REPOSITORY in DIRECTORY.
Then show the status buffer for the new repository.
Exclude commits reachable from EXCLUDE, which is a
branch or tag read from the user."
(interactive (append (magit-clone-read-args)
(list (read-string "Exclude commits reachable from: "))))
(magit-clone-internal repository directory
(cons (format "--shallow-exclude=%s" exclude) args)))
;;;###autoload
(defun magit-clone-bare (repository directory args)
"Create a bare clone of REPOSITORY in DIRECTORY.
Then show the status buffer for the new repository."
(interactive (magit-clone-read-args))
(magit-clone-internal repository directory (cons "--bare" args)))
;;;###autoload
(defun magit-clone-mirror (repository directory args)
"Create a mirror of REPOSITORY in DIRECTORY.
Then show the status buffer for the new repository."
(interactive (magit-clone-read-args))
(magit-clone-internal repository directory (cons "--mirror" args)))
;;;###autoload
(defun magit-clone-sparse (repository directory args)
"Clone REPOSITORY into DIRECTORY and create a sparse checkout."
(interactive (magit-clone-read-args))
(magit-clone-internal repository directory (cons "--no-checkout" args)
'sparse))
(defun magit-clone-internal (repository directory args &optional sparse)
(let* ((checkout (not (memq (car args) '("--bare" "--mirror"))))
(remote (or (transient-arg-value "--origin" args)
(magit-get "clone.defaultRemote")
"origin"))
(set-push-default
(and checkout
(or (eq magit-clone-set-remote.pushDefault t)
(and magit-clone-set-remote.pushDefault
(y-or-n-p (format "Set `remote.pushDefault' to %S? "
remote)))))))
(run-hooks 'magit-credential-hook)
(setq directory (file-name-as-directory (expand-file-name directory)))
(when (file-exists-p directory)
(if (file-directory-p directory)
(when (length> (directory-files directory) 2)
(let ((name (magit-clone--url-to-name repository)))
(unless (and name
(setq directory (file-name-as-directory
(expand-file-name name directory)))
(not (file-exists-p directory)))
(user-error "%s already exists" directory))))
(user-error "%s already exists and is not a directory" directory)))
(magit-run-git-async "clone" args "--" repository
(magit-convert-filename-for-git directory))
;; Don't refresh the buffer we're calling from.
(process-put magit-this-process 'inhibit-refresh t)
(set-process-sentinel
magit-this-process
(lambda (process event)
(when (memq (process-status process) '(exit signal))
(let ((magit-process-raise-error t))
(magit-process-sentinel process event)))
(when (and (eq (process-status process) 'exit)
(= (process-exit-status process) 0))
(when checkout
(let ((default-directory directory))
(when set-push-default
(setf (magit-get "remote.pushDefault") remote))
(unless magit-clone-set-remote-head
(magit-remote-unset-head remote))))
(when (and sparse checkout)
(when (magit-git-version< "2.25.0")
(user-error
"`git sparse-checkout' not available until Git v2.25"))
(let ((default-directory directory))
(magit-call-git "sparse-checkout" "init" "--cone")
(magit-call-git "checkout" (magit-get-current-branch))))
(with-current-buffer (process-get process 'command-buf)
(magit-status-setup-buffer directory)))))))
(defun magit-clone-read-args ()
(let ((repo (magit-clone-read-repository)))
(list repo
(read-directory-name
"Clone to: "
(if (functionp magit-clone-default-directory)
(funcall magit-clone-default-directory repo)
magit-clone-default-directory)
nil nil
(magit-clone--url-to-name repo))
(transient-args 'magit-clone))))
(defun magit-clone-read-repository ()
(magit-read-char-case "Clone from " nil
(?u "[u]rl or name"
(let ((str (magit-read-string-ns "Clone from url or name")))
(if (string-match-p "\\(://\\|@\\)" str)
str
(magit-clone--name-to-url str))))
(?p "[p]ath"
(magit-convert-filename-for-git
(read-directory-name "Clone repository: ")))
(?l "[l]ocal url"
(concat "file://"
(magit-convert-filename-for-git
(read-directory-name "Clone repository: file://"))))
(?b "or [b]undle"
(magit-convert-filename-for-git
(read-file-name "Clone from bundle: ")))))
(defun magit-clone--url-to-name (url)
(and (string-match "\\([^/:]+?\\)\\(/?\\.git\\)?$" url)
(match-string 1 url)))
(defun magit-clone--name-to-url (name)
(or (seq-some
(pcase-lambda (`(,re ,host ,user))
(and (string-match re name)
(let ((repo (match-string 1 name)))
(magit-clone--format-url host user repo))))
magit-clone-name-alist)
(user-error "Not an url and no matching entry in `%s'"
'magit-clone-name-alist)))
(defun magit-clone--format-url (host user repo)
(format-spec
magit-clone-url-format
`((?h . ,host)
(?n . ,(if (string-search "/" repo)
repo
(if (string-search "." user)
(if-let ((user (magit-get user)))
(concat user "/" repo)
(user-error "Set %S or specify owner explicitly" user))
(concat user "/" repo)))))))
;;; _
(provide 'magit-clone)
;;; magit-clone.el ends here

717
code/elpa/magit-20220425.1153/magit-commit.el Normal file
View file

@ -0,0 +1,717 @@
;;; magit-commit.el --- Create Git commits -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library implements commands for creating Git commits. These
;; commands just initiate the commit, support for writing the commit
;; messages is implemented in `git-commit.el'.
;;; Code:
(require 'magit)
(require 'magit-sequence)
(eval-when-compile (require 'epa)) ; for `epa-protocol'
(eval-when-compile (require 'epg))
;;; Options
(defcustom magit-commit-ask-to-stage 'verbose
"Whether to ask to stage everything when committing and nothing is staged."
:package-version '(magit . "2.3.0")
:group 'magit-commands
:type '(choice (const :tag "Ask" t)
(const :tag "Ask showing diff" verbose)
(const :tag "Stage without confirmation" stage)
(const :tag "Don't ask" nil)))
(defcustom magit-commit-show-diff t
"Whether the relevant diff is automatically shown when committing."
:package-version '(magit . "2.3.0")
:group 'magit-commands
:type 'boolean)
(defcustom magit-commit-extend-override-date t
"Whether using `magit-commit-extend' changes the committer date."
:package-version '(magit . "2.3.0")
:group 'magit-commands
:type 'boolean)
(defcustom magit-commit-reword-override-date t
"Whether using `magit-commit-reword' changes the committer date."
:package-version '(magit . "2.3.0")
:group 'magit-commands
:type 'boolean)
(defcustom magit-commit-squash-confirm t
"Whether the commit targeted by squash and fixup has to be confirmed.
When non-nil then the commit at point (if any) is used as default
choice, otherwise it has to be confirmed. This option only
affects `magit-commit-squash' and `magit-commit-fixup'. The
\"instant\" variants always require confirmation because making
an error while using those is harder to recover from."
:package-version '(magit . "2.1.0")
:group 'magit-commands
:type 'boolean)
(defcustom magit-post-commit-hook nil
"Hook run after creating a commit without the user editing a message.
This hook is run by `magit-refresh' if `this-command' is a member
of `magit-post-stage-hook-commands'. This only includes commands
named `magit-commit-*' that do *not* require that the user edits
the commit message in a buffer and then finishes by pressing
\\<with-editor-mode-map>\\[with-editor-finish].
Also see `git-commit-post-finish-hook'."
:package-version '(magit . "2.90.0")
:group 'magit-commands
:type 'hook)
(defcustom magit-commit-diff-inhibit-same-window nil
"Whether to inhibit use of same window when showing diff while committing.
When writing a commit, then a diff of the changes to be committed
is automatically shown. The idea is that the diff is shown in a
different window of the same frame and for most users that just
works. In other words most users can completely ignore this
option because its value doesn't make a difference for them.
However for users who configured Emacs to never create a new
window even when the package explicitly tries to do so, then
displaying two new buffers necessarily means that the first is
immediately replaced by the second. In our case the message
buffer is immediately replaced by the diff buffer, which is of
course highly undesirable.
A workaround is to suppress this user configuration in this
particular case. Users have to explicitly opt-in by toggling
this option. We cannot enable the workaround unconditionally
because that again causes issues for other users: if the frame
is too tiny or the relevant settings too aggressive, then the
diff buffer would end up being displayed in a new frame.
Also see https://github.com/magit/magit/issues/4132."
:package-version '(magit . "3.3.0")
:group 'magit-commands
:type 'boolean)
(defcustom magit-openpgp-default-signing-key nil
"Fingerprint of your default Openpgp key used for signing.
If the specified primary key has signing capacity then it is used
as the value of the `--gpg-sign' argument without prompting, even
when other such keys exist. To be able to select another key you
must then use a prefix argument."
:package-version '(magit . "3.4.0")
:group 'magit-commands
:type 'string)
(defvar magit-post-commit-hook-commands
'(magit-commit-extend
magit-commit-fixup
magit-commit-augment
magit-commit-instant-fixup
magit-commit-instant-squash))
;;; Popup
;;;###autoload (autoload 'magit-commit "magit-commit" nil t)
(transient-define-prefix magit-commit ()
"Create a new commit or replace an existing commit."
:info-manual "(magit)Initiating a Commit"
:man-page "git-commit"
["Arguments"
("-a" "Stage all modified and deleted files" ("-a" "--all"))
("-e" "Allow empty commit" "--allow-empty")
("-v" "Show diff of changes to be committed" ("-v" "--verbose"))
("-n" "Disable hooks" ("-n" "--no-verify"))
("-R" "Claim authorship and reset author date" "--reset-author")
(magit:--author :description "Override the author")
(7 "-D" "Override the author date" "--date=" transient-read-date)
("-s" "Add Signed-off-by line" ("-s" "--signoff"))
(5 magit:--gpg-sign)
(magit-commit:--reuse-message)]
[["Create"
("c" "Commit" magit-commit-create)]
["Edit HEAD"
("e" "Extend" magit-commit-extend)
("w" "Reword" magit-commit-reword)
("a" "Amend" magit-commit-amend)
(6 "n" "Reshelve" magit-commit-reshelve)]
["Edit"
("f" "Fixup" magit-commit-fixup)
("s" "Squash" magit-commit-squash)
("A" "Augment" magit-commit-augment)
(6 "x" "Absorb changes" magit-commit-autofixup)
(6 "X" "Absorb modules" magit-commit-absorb-modules)]
[""
("F" "Instant fixup" magit-commit-instant-fixup)
("S" "Instant squash" magit-commit-instant-squash)]]
(interactive)
(if-let ((buffer (magit-commit-message-buffer)))
(switch-to-buffer buffer)
(transient-setup 'magit-commit)))
(defun magit-commit-arguments nil
(transient-args 'magit-commit))
(transient-define-argument magit:--gpg-sign ()
:description "Sign using gpg"
:class 'transient-option
:shortarg "-S"
:argument "--gpg-sign="
:allow-empty t
:reader #'magit-read-gpg-signing-key)
(defvar magit-gpg-secret-key-hist nil)
(defun magit-read-gpg-secret-key
(prompt &optional initial-input history predicate default)
(require 'epa)
(let* ((keys (cl-mapcan
(lambda (cert)
(and (or (not predicate)
(funcall predicate cert))
(let* ((key (car (epg-key-sub-key-list cert)))
(fpr (epg-sub-key-fingerprint key))
(id (epg-sub-key-id key))
(author
(and-let* ((id-obj
(car (epg-key-user-id-list cert))))
(let ((id-str (epg-user-id-string id-obj)))
(if (stringp id-str)
id-str
(epg-decode-dn id-obj))))))
(list
(propertize fpr 'display
(concat (substring fpr 0 (- (length id)))
(propertize id 'face 'highlight)
" " author))))))
(epg-list-keys (epg-make-context epa-protocol) nil t)))
(choice (or (and (not current-prefix-arg)
(or (and (length= keys 1) (car keys))
(and default (car (member default keys)))))
(completing-read prompt keys nil nil nil
history nil initial-input))))
(set-text-properties 0 (length choice) nil choice)
choice))
(defun magit-read-gpg-signing-key (prompt &optional initial-input history)
(magit-read-gpg-secret-key
prompt initial-input history
(lambda (cert)
(cl-some (lambda (key)
(memq 'sign (epg-sub-key-capability key)))
(epg-key-sub-key-list cert)))
magit-openpgp-default-signing-key))
(transient-define-argument magit-commit:--reuse-message ()
:description "Reuse commit message"
:class 'transient-option
:shortarg "-C"
:argument "--reuse-message="
:reader #'magit-read-reuse-message
:history-key 'magit-revision-history)
(defun magit-read-reuse-message (prompt &optional default history)
(magit-completing-read prompt (magit-list-refnames)
nil nil nil history
(or default
(and (magit-rev-verify "ORIG_HEAD")
"ORIG_HEAD"))))
;;; Commands
;;;###autoload
(defun magit-commit-create (&optional args)
"Create a new commit on `HEAD'.
With a prefix argument, amend to the commit at `HEAD' instead.
\n(git commit [--amend] ARGS)"
(interactive (if current-prefix-arg
(list (cons "--amend" (magit-commit-arguments)))
(list (magit-commit-arguments))))
(when (member "--all" args)
(setq this-command 'magit-commit-all))
(when (setq args (magit-commit-assert args))
(let ((default-directory (magit-toplevel)))
(magit-run-git-with-editor "commit" args))))
;;;###autoload
(defun magit-commit-amend (&optional args)
"Amend the last commit.
\n(git commit --amend ARGS)"
(interactive (list (magit-commit-arguments)))
(magit-commit-amend-assert)
(magit-run-git-with-editor "commit" "--amend" args))
;;;###autoload
(defun magit-commit-extend (&optional args override-date)
"Amend the last commit, without editing the message.
With a prefix argument keep the committer date, otherwise change
it. The option `magit-commit-extend-override-date' can be used
to inverse the meaning of the prefix argument. \n(git commit
--amend --no-edit)"
(interactive (list (magit-commit-arguments)
(if current-prefix-arg
(not magit-commit-extend-override-date)
magit-commit-extend-override-date)))
(when (setq args (magit-commit-assert args))
(magit-commit-amend-assert)
(if override-date
(magit-run-git-with-editor "commit" "--amend" "--no-edit" args)
(with-environment-variables
(("GIT_COMMITTER_DATE" (magit-rev-format "%cD")))
(magit-run-git-with-editor "commit" "--amend" "--no-edit" args)))))
;;;###autoload
(defun magit-commit-reword (&optional args override-date)
"Reword the last commit, ignoring staged changes.
With a prefix argument keep the committer date, otherwise change
it. The option `magit-commit-reword-override-date' can be used
to inverse the meaning of the prefix argument.
Non-interactively respect the optional OVERRIDE-DATE argument
and ignore the option.
\n(git commit --amend --only)"
(interactive (list (magit-commit-arguments)
(if current-prefix-arg
(not magit-commit-reword-override-date)
magit-commit-reword-override-date)))
(magit-commit-amend-assert)
(cl-pushnew "--allow-empty" args :test #'equal)
(if override-date
(magit-run-git-with-editor "commit" "--amend" "--only" args)
(with-environment-variables
(("GIT_COMMITTER_DATE" (magit-rev-format "%cD")))
(magit-run-git-with-editor "commit" "--amend" "--only" args))))
;;;###autoload
(defun magit-commit-fixup (&optional commit args)
"Create a fixup commit.
With a prefix argument the target COMMIT has to be confirmed.
Otherwise the commit at point may be used without confirmation
depending on the value of option `magit-commit-squash-confirm'."
(interactive (list (magit-commit-at-point)
(magit-commit-arguments)))
(magit-commit-squash-internal "--fixup" commit args))
;;;###autoload
(defun magit-commit-squash (&optional commit args)
"Create a squash commit, without editing the squash message.
With a prefix argument the target COMMIT has to be confirmed.
Otherwise the commit at point may be used without confirmation
depending on the value of option `magit-commit-squash-confirm'.
If you want to immediately add a message to the squash commit,
then use `magit-commit-augment' instead of this command."
(interactive (list (magit-commit-at-point)
(magit-commit-arguments)))
(magit-commit-squash-internal "--squash" commit args))
;;;###autoload
(defun magit-commit-augment (&optional commit args)
"Create a squash commit, editing the squash message.
With a prefix argument the target COMMIT has to be confirmed.
Otherwise the commit at point may be used without confirmation
depending on the value of option `magit-commit-squash-confirm'."
(interactive (list (magit-commit-at-point)
(magit-commit-arguments)))
(magit-commit-squash-internal "--squash" commit args nil t))
;;;###autoload
(defun magit-commit-instant-fixup (&optional commit args)
"Create a fixup commit targeting COMMIT and instantly rebase."
(interactive (list (magit-commit-at-point)
(magit-commit-arguments)))
(magit-commit-squash-internal "--fixup" commit args t))
;;;###autoload
(defun magit-commit-instant-squash (&optional commit args)
"Create a squash commit targeting COMMIT and instantly rebase."
(interactive (list (magit-commit-at-point)
(magit-commit-arguments)))
(magit-commit-squash-internal "--squash" commit args t))
(defun magit-commit-squash-internal
(option commit &optional args rebase edit confirmed)
(when-let ((args (magit-commit-assert args (not edit))))
(when commit
(when (and rebase (not (magit-rev-ancestor-p commit "HEAD")))
(magit-read-char-case
(format "%s isn't an ancestor of HEAD. " commit) nil
(?c "[c]reate without rebasing" (setq rebase nil))
(?s "[s]elect other" (setq commit nil))
(?a "[a]bort" (user-error "Quit")))))
(when commit
(setq commit (magit-rebase-interactive-assert commit t)))
(if (and commit
(or confirmed
(not (or rebase
current-prefix-arg
magit-commit-squash-confirm))))
(let ((magit-commit-show-diff nil))
(push (concat option "=" commit) args)
(unless edit
(push "--no-edit" args))
(if rebase
(magit-with-editor
(magit-call-git
"commit" "--no-gpg-sign"
(-remove-first
(apply-partially #'string-prefix-p "--gpg-sign=")
args)))
(magit-run-git-with-editor "commit" args))
t) ; The commit was created; used by below lambda.
(magit-log-select
(lambda (commit)
(when (and (magit-commit-squash-internal option commit args
rebase edit t)
rebase)
(magit-commit-amend-assert commit)
(magit-rebase-interactive-1 commit
(list "--autosquash" "--autostash" "--keep-empty")
"" "true" nil t)))
(format "Type %%p on a commit to %s into it,"
(substring option 2))
nil nil nil commit)
(when magit-commit-show-diff
(let ((magit-display-buffer-noselect t))
(apply #'magit-diff-staged nil (magit-diff-arguments)))))))
(defun magit-commit-amend-assert (&optional commit)
(--when-let (magit-list-publishing-branches commit)
(let ((m1 "This commit has already been published to ")
(m2 ".\nDo you really want to modify it"))
(magit-confirm 'amend-published
(concat m1 "%s" m2)
(concat m1 "%i public branches" m2)
nil it))))
(defun magit-commit-assert (args &optional strict)
(cond
((or (magit-anything-staged-p)
(and (magit-anything-unstaged-p)
;; ^ Everything of nothing is still nothing.
(member "--all" args))
(and (not strict)
;; ^ For amend variants that don't make sense otherwise.
(or (member "--amend" args)
(member "--allow-empty" args)
(member "--reset-author" args)
(member "--signoff" args)
(transient-arg-value "--author=" args)
(transient-arg-value "--date=" args))))
(or args (list "--")))
((and (magit-rebase-in-progress-p)
(not (magit-anything-unstaged-p))
(y-or-n-p "Nothing staged. Continue in-progress rebase? "))
(setq this-command #'magit-rebase-continue)
(magit-run-git-sequencer "rebase" "--continue")
nil)
((and (file-exists-p (magit-git-dir "MERGE_MSG"))
(not (magit-anything-unstaged-p)))
(or args (list "--")))
((not (magit-anything-unstaged-p))
(user-error "Nothing staged (or unstaged)"))
(magit-commit-ask-to-stage
(when (eq magit-commit-ask-to-stage 'verbose)
(magit-diff-unstaged))
(prog1 (when (or (eq magit-commit-ask-to-stage 'stage)
(y-or-n-p "Nothing staged. Stage and commit all unstaged changes? "))
(magit-run-git "add" "-u" ".")
(or args (list "--")))
(when (and (eq magit-commit-ask-to-stage 'verbose)
(derived-mode-p 'magit-diff-mode))
(magit-mode-bury-buffer))))
(t
(user-error "Nothing staged"))))
(defvar magit--reshelve-history nil)
;;;###autoload
(defun magit-commit-reshelve (date update-author &optional args)
"Change the committer date and possibly the author date of `HEAD'.
The current time is used as the initial minibuffer input and the
original author or committer date is available as the previous
history element.
Both the author and the committer dates are changes, unless one
of the following is true, in which case only the committer date
is updated:
- You are not the author of the commit that is being reshelved.
- The command was invoked with a prefix argument.
- Non-interactively if UPDATE-AUTHOR is nil."
(interactive
(let ((update-author (and (magit-rev-author-p "HEAD")
(not current-prefix-arg))))
(push (magit-rev-format (if update-author "%ad" "%cd") "HEAD"
(concat "--date=format:%F %T %z"))
magit--reshelve-history)
(list (read-string (if update-author
"Change author and committer dates to: "
"Change committer date to: ")
(cons (format-time-string "%F %T %z") 17)
'magit--reshelve-history)
update-author
(magit-commit-arguments))))
(with-environment-variables (("GIT_COMMITTER_DATE" date))
(magit-run-git "commit" "--amend" "--no-edit"
(and update-author (concat "--date=" date))
args)))
;;;###autoload
(defun magit-commit-absorb-modules (phase commit)
"Spread modified modules across recent commits."
(interactive (list 'select (magit-get-upstream-branch)))
(let ((modules (magit-list-modified-modules)))
(unless modules
(user-error "There are no modified modules that could be absorbed"))
(when commit
(setq commit (magit-rebase-interactive-assert commit t)))
(if (and commit (eq phase 'run))
(progn
(dolist (module modules)
(when-let ((msg (magit-git-string
"log" "-1" "--format=%s"
(concat commit "..") "--" module)))
(magit-git "commit" "-m" (concat "fixup! " msg)
"--only" "--" module)))
(magit-refresh)
t)
(magit-log-select
(lambda (commit)
(magit-commit-absorb-modules 'run commit))
nil nil nil nil commit))))
;;;###autoload (autoload 'magit-commit-absorb "magit-commit" nil t)
(transient-define-prefix magit-commit-absorb (phase commit args)
"Spread staged changes across recent commits.
With a prefix argument use a transient command to select infix
arguments. This command requires git-absorb executable, which
is available from https://github.com/tummychow/git-absorb.
See `magit-commit-autofixup' for an alternative implementation."
["Arguments"
("-f" "Skip safety checks" ("-f" "--force"))
("-v" "Display more output" ("-v" "--verbose"))]
["Actions"
("x" "Absorb" magit-commit-absorb)]
(interactive (if current-prefix-arg
(list 'transient nil nil)
(list 'select
(magit-get-upstream-branch)
(transient-args 'magit-commit-absorb))))
(if (eq phase 'transient)
(transient-setup 'magit-commit-absorb)
(unless (compat-executable-find "git-absorb" t)
(user-error "This command requires the git-absorb executable, which %s"
"is available from https://github.com/tummychow/git-absorb"))
(unless (magit-anything-staged-p)
(if (magit-anything-unstaged-p)
(if (y-or-n-p "Nothing staged. Absorb all unstaged changes? ")
(magit-with-toplevel
(magit-run-git "add" "-u" "."))
(user-error "Abort"))
(user-error "There are no changes that could be absorbed")))
(when commit
(setq commit (magit-rebase-interactive-assert commit t)))
(if (and commit (eq phase 'run))
(progn (magit-run-git-async "absorb" "-v" args "-b" commit) t)
(magit-log-select
(lambda (commit)
(with-no-warnings ; about non-interactive use
(magit-commit-absorb 'run commit args)))
nil nil nil nil commit))))
;;;###autoload (autoload 'magit-commit-autofixup "magit-commit" nil t)
(transient-define-prefix magit-commit-autofixup (phase commit args)
"Spread staged or unstaged changes across recent commits.
If there are any staged then spread only those, otherwise
spread all unstaged changes. With a prefix argument use a
transient command to select infix arguments.
This command requires the git-autofixup script, which is
available from https://github.com/torbiak/git-autofixup.
See `magit-commit-absorb' for an alternative implementation."
["Arguments"
(magit-autofixup:--context)
(magit-autofixup:--strict)]
["Actions"
("x" "Absorb" magit-commit-autofixup)]
(interactive (if current-prefix-arg
(list 'transient nil nil)
(list 'select
(magit-get-upstream-branch)
(transient-args 'magit-commit-autofixup))))
(if (eq phase 'transient)
(transient-setup 'magit-commit-autofixup)
(unless (compat-executable-find "git-autofixup" t)
(user-error "This command requires the git-autofixup script, which %s"
"is available from https://github.com/torbiak/git-autofixup"))
(unless (magit-anything-modified-p)
(user-error "There are no changes that could be absorbed"))
(when commit
(setq commit (magit-rebase-interactive-assert commit t)))
(if (and commit (eq phase 'run))
(progn (magit-run-git-async "autofixup" "-vv" args commit) t)
(magit-log-select
(lambda (commit)
(with-no-warnings ; about non-interactive use
(magit-commit-autofixup 'run commit args)))
nil nil nil nil commit))))
(transient-define-argument magit-autofixup:--context ()
:description "Diff context lines"
:class 'transient-option
:shortarg "-c"
:argument "--context="
:reader #'transient-read-number-N0)
(transient-define-argument magit-autofixup:--strict ()
:description "Strictness"
:class 'transient-option
:shortarg "-s"
:argument "--strict="
:reader #'transient-read-number-N0)
;;; Pending Diff
(defun magit-commit-diff ()
(when (and git-commit-mode magit-commit-show-diff)
(when-let ((diff-buffer (magit-get-mode-buffer 'magit-diff-mode)))
;; This window just started displaying the commit message
;; buffer. Without this that buffer would immediately be
;; replaced with the diff buffer. See #2632.
(unrecord-window-buffer nil diff-buffer))
(condition-case nil
(let ((args (car (magit-diff-arguments)))
(magit-inhibit-save-previous-winconf 'unset)
(magit-display-buffer-noselect t)
(inhibit-quit nil)
(display-buffer-overriding-action
display-buffer-overriding-action))
(when magit-commit-diff-inhibit-same-window
(setq display-buffer-overriding-action
'(nil (inhibit-same-window t))))
(message "Diffing changes to be committed (C-g to abort diffing)")
(cl-case last-command
(magit-commit
(magit-diff-staged nil args))
(magit-commit-all
(magit-diff-working-tree nil args))
((magit-commit-amend
magit-commit-reword
magit-rebase-reword-commit)
(magit-diff-while-amending args))
(t (if (magit-anything-staged-p)
(magit-diff-staged nil args)
(magit-diff-while-amending args)))))
(quit))))
;; Mention `magit-diff-while-committing' because that's
;; always what I search for when I try to find this line.
(add-hook 'server-switch-hook #'magit-commit-diff)
(add-hook 'with-editor-filter-visit-hook #'magit-commit-diff)
(add-to-list 'with-editor-server-window-alist
(cons git-commit-filename-regexp #'switch-to-buffer))
;;; Message Utilities
(defun magit-commit-message-buffer ()
(let* ((find-file-visit-truename t) ; git uses truename of COMMIT_EDITMSG
(topdir (magit-toplevel)))
(--first (equal topdir (with-current-buffer it
(and git-commit-mode (magit-toplevel))))
(append (buffer-list (selected-frame))
(buffer-list)))))
(defvar magit-commit-add-log-insert-function #'magit-commit-add-log-insert
"Used by `magit-commit-add-log' to insert a single entry.")
(defun magit-commit-add-log ()
"Add a stub for the current change into the commit message buffer.
If no commit is in progress, then initiate it. Use the function
specified by variable `magit-commit-add-log-insert-function' to
actually insert the entry."
(interactive)
(pcase-let* ((hunk (and (magit-section-match 'hunk)
(magit-current-section)))
(log (magit-commit-message-buffer))
(`(,buf ,pos) (magit-diff-visit-file--noselect)))
(unless log
(unless (magit-commit-assert nil)
(user-error "Abort"))
(magit-commit-create)
(while (not (setq log (magit-commit-message-buffer)))
(sit-for 0.01)))
(magit--with-temp-position buf pos
(funcall magit-commit-add-log-insert-function log
(magit-file-relative-name)
(and hunk (add-log-current-defun))))))
(defun magit-commit-add-log-insert (buffer file defun)
(with-current-buffer buffer
(undo-boundary)
(goto-char (point-max))
(while (re-search-backward (concat "^" comment-start) nil t))
(save-restriction
(narrow-to-region (point-min) (point))
(cond ((re-search-backward (format "* %s\\(?: (\\([^)]+\\))\\)?: " file)
nil t)
(when (equal (match-string 1) defun)
(setq defun nil))
(re-search-forward ": "))
(t
(when (re-search-backward "^[\\*(].+\n" nil t)
(goto-char (match-end 0)))
(while (re-search-forward "^[^\\*\n].*\n" nil t))
(if defun
(progn (insert (format "* %s (%s): \n" file defun))
(setq defun nil))
(insert (format "* %s: \n" file)))
(backward-char)
(unless (looking-at "\n[\n\\']")
(insert ?\n)
(backward-char))))
(when defun
(forward-line)
(let ((limit (save-excursion
(and (re-search-forward "^\\*" nil t)
(point)))))
(unless (or (looking-back (format "(%s): " defun)
(line-beginning-position))
(re-search-forward (format "^(%s): " defun) limit t))
(while (re-search-forward "^[^\\*\n].*\n" limit t))
(insert (format "(%s): \n" defun))
(backward-char)))))))
;;; _
(provide 'magit-commit)
;;; magit-commit.el ends here

129
code/elpa/magit-20220425.1153/magit-core.el Normal file
View file

@ -0,0 +1,129 @@
;;; magit-core.el --- Core functionality -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library requires several other libraries, so that yet other
;; libraries can just require this one, instead of having to require
;; all the other ones. In other words this separates the low-level
;; stuff from the rest. It also defines some Custom groups.
;;; Code:
(require 'magit-base)
(require 'magit-git)
(require 'magit-mode)
(require 'magit-margin)
(require 'magit-process)
(require 'magit-transient)
(require 'magit-autorevert)
(when (magit--libgit-available-p)
(condition-case err
(require 'magit-libgit)
(error
(setq magit-inhibit-libgit 'error)
(message "Error while loading `magit-libgit': %S" err)
(message "That is not fatal. The `libegit2' module just won't be used."))))
(defgroup magit nil
"Controlling Git from Emacs."
:link '(url-link "https://magit.vc")
:link '(info-link "(magit)FAQ")
:link '(info-link "(magit)")
:group 'tools)
(defgroup magit-essentials nil
"Options that every Magit user should briefly think about.
Each of these options falls into one or more of these categories:
* Options that affect Magit's behavior in fundamental ways.
* Options that affect safety.
* Options that affect performance.
* Options that are of a personal nature."
:link '(info-link "(magit)Essential Settings")
:group 'magit)
(defgroup magit-miscellaneous nil
"Miscellaneous Magit options."
:group 'magit)
(defgroup magit-commands nil
"Options controlling behavior of certain commands."
:group 'magit)
(defgroup magit-modes nil
"Modes used or provided by Magit."
:group 'magit)
(defgroup magit-buffers nil
"Options concerning Magit buffers."
:link '(info-link "(magit)Modes and Buffers")
:group 'magit)
(defgroup magit-refresh nil
"Options controlling how Magit buffers are refreshed."
:link '(info-link "(magit)Automatic Refreshing of Magit Buffers")
:group 'magit
:group 'magit-buffers)
(defgroup magit-faces nil
"Faces used by Magit."
:group 'magit
:group 'faces)
(custom-add-to-group 'magit-faces 'diff-refine-added 'custom-face)
(custom-add-to-group 'magit-faces 'diff-refine-removed 'custom-face)
(defgroup magit-extensions nil
"Extensions to Magit."
:group 'magit)
(custom-add-to-group 'magit-modes 'git-commit 'custom-group)
(custom-add-to-group 'magit-faces 'git-commit-faces 'custom-group)
(custom-add-to-group 'magit-modes 'git-rebase 'custom-group)
(custom-add-to-group 'magit-faces 'git-rebase-faces 'custom-group)
(custom-add-to-group 'magit 'magit-section 'custom-group)
(custom-add-to-group 'magit-faces 'magit-section-faces 'custom-group)
(custom-add-to-group 'magit-process 'with-editor 'custom-group)
(defgroup magit-related nil
"Options that are relevant to Magit but that are defined elsewhere."
:link '(custom-group-link vc)
:link '(custom-group-link smerge)
:link '(custom-group-link ediff)
:link '(custom-group-link auto-revert)
:group 'magit
:group 'magit-extensions
:group 'magit-essentials)
(custom-add-to-group 'magit-related 'auto-revert-check-vc-info 'custom-variable)
(custom-add-to-group 'magit-auto-revert 'auto-revert-check-vc-info 'custom-variable)
(custom-add-to-group 'magit-related 'ediff-window-setup-function 'custom-variable)
(custom-add-to-group 'magit-related 'smerge-refine-ignore-whitespace 'custom-variable)
(custom-add-to-group 'magit-related 'vc-follow-symlinks 'custom-variable)
;;; _
(provide 'magit-core)
;;; magit-core.el ends here

3435
code/elpa/magit-20220425.1153/magit-diff.el Normal file
View file

File diff suppressed because it is too large Load diff

483
code/elpa/magit-20220425.1153/magit-ediff.el Normal file
View file

@ -0,0 +1,483 @@
;;; magit-ediff.el --- Ediff extension for Magit -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library provides basic support for Ediff.
;;; Code:
(require 'magit)
(require 'ediff)
(require 'smerge-mode)
(defvar smerge-ediff-buf)
(defvar smerge-ediff-windows)
;;; Options
(defgroup magit-ediff nil
"Ediff support for Magit."
:link '(info-link "(magit)Ediffing")
:group 'magit-extensions)
(defcustom magit-ediff-quit-hook
'(magit-ediff-cleanup-auxiliary-buffers
magit-ediff-restore-previous-winconf)
"Hooks to run after finishing Ediff, when that was invoked using Magit.
The hooks are run in the Ediff control buffer. This is similar
to `ediff-quit-hook' but takes the needs of Magit into account.
The `ediff-quit-hook' is ignored by Ediff sessions which were
invoked using Magit."
:package-version '(magit . "2.2.0")
:group 'magit-ediff
:type 'hook
:get #'magit-hook-custom-get
:options '(magit-ediff-cleanup-auxiliary-buffers
magit-ediff-restore-previous-winconf))
(defcustom magit-ediff-dwim-show-on-hunks nil
"Whether `magit-ediff-dwim' runs show variants on hunks.
If non-nil, `magit-ediff-show-staged' or
`magit-ediff-show-unstaged' are called based on what section the
hunk is in. Otherwise, `magit-ediff-dwim' runs
`magit-ediff-stage' when point is on an uncommitted hunk."
:package-version '(magit . "2.2.0")
:group 'magit-ediff
:type 'boolean)
(defcustom magit-ediff-show-stash-with-index t
"Whether `magit-ediff-show-stash' shows the state of the index.
If non-nil, use a third Ediff buffer to distinguish which changes
in the stash were staged. In cases where the stash contains no
staged changes, fall back to a two-buffer Ediff.
More specifically, a stash is a merge commit, stash@{N}, with
potentially three parents.
* stash@{N}^1 represents the `HEAD' commit at the time the stash
was created.
* stash@{N}^2 records any changes that were staged when the stash
was made.
* stash@{N}^3, if it exists, contains files that were untracked
when stashing.
If this option is non-nil, `magit-ediff-show-stash' will run
Ediff on a file using three buffers: one for stash@{N}, another
for stash@{N}^1, and a third for stash@{N}^2.
Otherwise, Ediff uses two buffers, comparing
stash@{N}^1..stash@{N}. Along with any unstaged changes, changes
in the index commit, stash@{N}^2, will be shown in this
comparison unless they conflicted with changes in the working
tree at the time of stashing."
:package-version '(magit . "2.6.0")
:group 'magit-ediff
:type 'boolean)
(defvar magit-ediff-use-indirect-buffers nil
"Whether to use indirect buffers.
Ediff already does a lot of buffer and file shuffling and I
recommend you do not further complicate that by enabling this.")
;;; Commands
(defvar magit-ediff-previous-winconf nil)
;;;###autoload (autoload 'magit-ediff "magit-ediff" nil)
(transient-define-prefix magit-ediff ()
"Show differences using the Ediff package."
:info-manual "(ediff)"
["Ediff"
[("E" "Dwim" magit-ediff-dwim)
("s" "Stage" magit-ediff-stage)
("m" "Resolve" magit-ediff-resolve)
("t" "Resolve using mergetool" magit-git-mergetool)]
[("u" "Show unstaged" magit-ediff-show-unstaged)
("i" "Show staged" magit-ediff-show-staged)
("w" "Show worktree" magit-ediff-show-working-tree)]
[("c" "Show commit" magit-ediff-show-commit)
("r" "Show range" magit-ediff-compare)
("z" "Show stash" magit-ediff-show-stash)]])
;;;###autoload
(defun magit-ediff-resolve (file)
"Resolve outstanding conflicts in FILE using Ediff.
FILE has to be relative to the top directory of the repository.
In the rare event that you want to manually resolve all
conflicts, including those already resolved by Git, use
`ediff-merge-revisions-with-ancestor'."
(interactive (list (magit-read-unmerged-file)))
(magit-with-toplevel
(with-current-buffer (find-file-noselect file)
(smerge-ediff)
(setq-local
ediff-quit-hook
(lambda ()
(let ((bufC ediff-buffer-C)
(bufS smerge-ediff-buf))
(with-current-buffer bufS
(when (yes-or-no-p (format "Conflict resolution finished; save %s? "
buffer-file-name))
(erase-buffer)
(insert-buffer-substring bufC)
(save-buffer))))
(when (buffer-live-p ediff-buffer-A) (kill-buffer ediff-buffer-A))
(when (buffer-live-p ediff-buffer-B) (kill-buffer ediff-buffer-B))
(when (buffer-live-p ediff-buffer-C) (kill-buffer ediff-buffer-C))
(when (buffer-live-p ediff-ancestor-buffer)
(kill-buffer ediff-ancestor-buffer))
(let ((magit-ediff-previous-winconf smerge-ediff-windows))
(run-hooks 'magit-ediff-quit-hook)))))))
(defmacro magit-ediff-buffers (quit &rest spec)
(declare (indent 1))
(let ((fn (if (length= spec 3) 'ediff-buffers3 'ediff-buffers))
(char ?@)
get make kill)
(pcase-dolist (`(,g ,m) spec)
(let ((b (intern (format "buf%c" (cl-incf char)))))
(push `(,b ,g) get)
(push `(if ,b
(if magit-ediff-use-indirect-buffers
(prog1
(make-indirect-buffer
,b (generate-new-buffer-name (buffer-name ,b)) t)
(setq ,b nil))
,b)
,m)
make)
(push `(unless ,b
(ediff-kill-buffer-carefully
,(intern (format "ediff-buffer-%c" char))))
kill)))
(setq get (nreverse get))
(setq make (nreverse make))
(setq kill (nreverse kill))
`(magit-with-toplevel
(let ((conf (current-window-configuration))
,@get)
(,fn
,@make
(list (lambda ()
(setq-local
ediff-quit-hook
(list ,@(and quit (list quit))
(lambda ()
,@kill
(let ((magit-ediff-previous-winconf conf))
(run-hooks 'magit-ediff-quit-hook)))))))
',fn)))))
;;;###autoload
(defun magit-ediff-stage (file)
"Stage and unstage changes to FILE using Ediff.
FILE has to be relative to the top directory of the repository."
(interactive
(let ((files (magit-tracked-files)))
(list (magit-completing-read "Selectively stage file" files nil t nil nil
(car (member (magit-current-file) files))))))
(magit-with-toplevel
(let* ((bufA (magit-get-revision-buffer "HEAD" file))
(bufB (magit-get-revision-buffer "{index}" file))
(lockB (and bufB (buffer-local-value 'buffer-read-only bufB)))
(bufC (get-file-buffer file))
;; Use the same encoding for all three buffers or we
;; may end up changing the file in an unintended way.
(bufC* (or bufC (find-file-noselect file)))
(coding-system-for-read
(buffer-local-value 'buffer-file-coding-system bufC*))
(bufA* (magit-find-file-noselect-1 "HEAD" file t))
(bufB* (magit-find-file-index-noselect file t)))
(setf (buffer-local-value 'buffer-read-only bufB*) nil)
(magit-ediff-buffers
(lambda ()
(when (buffer-live-p ediff-buffer-B)
(when lockB
(setf (buffer-local-value 'buffer-read-only bufB) t))
(when (buffer-modified-p ediff-buffer-B)
(with-current-buffer ediff-buffer-B
(magit-update-index))))
(when (and (buffer-live-p ediff-buffer-C)
(buffer-modified-p ediff-buffer-C))
(with-current-buffer ediff-buffer-C
(when (y-or-n-p (format "Save file %s? " buffer-file-name))
(save-buffer)))))
(bufA bufA*)
(bufB bufB*)
(bufC bufC*)))))
;;;###autoload
(defun magit-ediff-compare (revA revB fileA fileB)
"Compare REVA:FILEA with REVB:FILEB using Ediff.
FILEA and FILEB have to be relative to the top directory of the
repository. If REVA or REVB is nil, then this stands for the
working tree state.
If the region is active, use the revisions on the first and last
line of the region. With a prefix argument, instead of diffing
the revisions, choose a revision to view changes along, starting
at the common ancestor of both revisions (i.e., use a \"...\"
range)."
(interactive
(pcase-let ((`(,revA ,revB) (magit-ediff-compare--read-revisions
nil current-prefix-arg)))
(nconc (list revA revB)
(magit-ediff-read-files revA revB))))
(magit-ediff-buffers nil
((if revA (magit-get-revision-buffer revA fileA) (get-file-buffer fileA))
(if revA (magit-find-file-noselect revA fileA) (find-file-noselect fileA)))
((if revB (magit-get-revision-buffer revB fileB) (get-file-buffer fileB))
(if revB (magit-find-file-noselect revB fileB) (find-file-noselect fileB)))))
(defun magit-ediff-compare--read-revisions (&optional arg mbase)
(let ((input (or arg (magit-diff-read-range-or-commit
"Compare range or commit"
nil mbase))))
(--if-let (magit-split-range input)
(-cons-to-list it)
(list input nil))))
(defun magit-ediff-read-files (revA revB &optional fileB)
"Read file in REVB, return it and the corresponding file in REVA.
When FILEB is non-nil, use this as REVB's file instead of
prompting for it."
(unless (and fileB (member fileB (magit-revision-files revB)))
(setq fileB
(or (and fileB
magit-buffer-log-files
(derived-mode-p 'magit-log-mode)
(member "--follow" magit-buffer-log-args)
(cdr (assoc fileB
(magit-renamed-files
revB
(oref (car (oref magit-root-section children))
value)))))
(magit-read-file-choice
(format "File to compare between %s and %s"
revA (or revB "the working tree"))
(magit-changed-files revA revB)
(format "No changed files between %s and %s"
revA (or revB "the working tree"))))))
(list (or (car (member fileB (magit-revision-files revA)))
(cdr (assoc fileB (magit-renamed-files revB revA)))
(magit-read-file-choice
(format "File in %s to compare with %s in %s"
revA fileB (or revB "the working tree"))
(magit-changed-files revB revA)
(format "No files have changed between %s and %s"
revA revB)))
fileB))
;;;###autoload
(defun magit-ediff-dwim ()
"Compare, stage, or resolve using Ediff.
This command tries to guess what file, and what commit or range
the user wants to compare, stage, or resolve using Ediff. It
might only be able to guess either the file, or range or commit,
in which case the user is asked about the other. It might not
always guess right, in which case the appropriate `magit-ediff-*'
command has to be used explicitly. If it cannot read the user's
mind at all, then it asks the user for a command to run."
(interactive)
(magit-section-case
(hunk (save-excursion
(goto-char (oref (oref it parent) start))
(magit-ediff-dwim)))
(t
(let ((range (magit-diff--dwim))
(file (magit-current-file))
command revA revB)
(pcase range
((and (guard (not magit-ediff-dwim-show-on-hunks))
(or 'unstaged 'staged))
(setq command (if (magit-anything-unmerged-p)
#'magit-ediff-resolve
#'magit-ediff-stage)))
('unstaged (setq command #'magit-ediff-show-unstaged))
('staged (setq command #'magit-ediff-show-staged))
(`(commit . ,value)
(setq command #'magit-ediff-show-commit)
(setq revB value))
(`(stash . ,value)
(setq command #'magit-ediff-show-stash)
(setq revB value))
((pred stringp)
(pcase-let ((`(,a ,b) (magit-ediff-compare--read-revisions range)))
(setq command #'magit-ediff-compare)
(setq revA a)
(setq revB b)))
(_
(when (derived-mode-p 'magit-diff-mode)
(pcase (magit-diff-type)
('committed (pcase-let ((`(,a ,b)
(magit-ediff-compare--read-revisions
magit-buffer-range)))
(setq revA a)
(setq revB b)))
((guard (not magit-ediff-dwim-show-on-hunks))
(setq command #'magit-ediff-stage))
('unstaged (setq command #'magit-ediff-show-unstaged))
('staged (setq command #'magit-ediff-show-staged))
('undefined (setq command nil))
(_ (setq command nil))))))
(cond ((not command)
(call-interactively
(magit-read-char-case
"Failed to read your mind; do you want to " t
(?c "[c]ommit" #'magit-ediff-show-commit)
(?r "[r]ange" #'magit-ediff-compare)
(?s "[s]tage" #'magit-ediff-stage)
(?v "resol[v]e" #'magit-ediff-resolve))))
((eq command #'magit-ediff-compare)
(apply #'magit-ediff-compare revA revB
(magit-ediff-read-files revA revB file)))
((eq command #'magit-ediff-show-commit)
(magit-ediff-show-commit revB))
((eq command #'magit-ediff-show-stash)
(magit-ediff-show-stash revB))
(file
(funcall command file))
(t
(call-interactively command)))))))
;;;###autoload
(defun magit-ediff-show-staged (file)
"Show staged changes using Ediff.
This only allows looking at the changes; to stage, unstage,
and discard changes using Ediff, use `magit-ediff-stage'.
FILE must be relative to the top directory of the repository."
(interactive
(list (magit-read-file-choice "Show staged changes for file"
(magit-staged-files)
"No staged files")))
(magit-ediff-buffers nil
((magit-get-revision-buffer "HEAD" file)
(magit-find-file-noselect "HEAD" file))
((get-buffer (concat file ".~{index}~"))
(magit-find-file-index-noselect file t))))
;;;###autoload
(defun magit-ediff-show-unstaged (file)
"Show unstaged changes using Ediff.
This only allows looking at the changes; to stage, unstage,
and discard changes using Ediff, use `magit-ediff-stage'.
FILE must be relative to the top directory of the repository."
(interactive
(list (magit-read-file-choice "Show unstaged changes for file"
(magit-unstaged-files)
"No unstaged files")))
(magit-ediff-buffers nil
((get-buffer (concat file ".~{index}~"))
(magit-find-file-index-noselect file t))
((get-file-buffer file)
(find-file-noselect file))))
;;;###autoload
(defun magit-ediff-show-working-tree (file)
"Show changes between `HEAD' and working tree using Ediff.
FILE must be relative to the top directory of the repository."
(interactive
(list (magit-read-file-choice "Show changes in file"
(magit-changed-files "HEAD")
"No changed files")))
(magit-ediff-buffers nil
((magit-get-revision-buffer "HEAD" file)
(magit-find-file-noselect "HEAD" file))
((get-file-buffer file)
(find-file-noselect file))))
;;;###autoload
(defun magit-ediff-show-commit (commit)
"Show changes introduced by COMMIT using Ediff."
(interactive (list (magit-read-branch-or-commit "Revision")))
(let ((revA (concat commit "^"))
(revB commit))
(apply #'magit-ediff-compare
revA revB
(magit-ediff-read-files revA revB (magit-current-file)))))
;;;###autoload
(defun magit-ediff-show-stash (stash)
"Show changes introduced by STASH using Ediff.
`magit-ediff-show-stash-with-index' controls whether a
three-buffer Ediff is used in order to distinguish changes in the
stash that were staged."
(interactive (list (magit-read-stash "Stash")))
(pcase-let* ((revA (concat stash "^1"))
(revB (concat stash "^2"))
(revC stash)
(`(,fileA ,fileC) (magit-ediff-read-files revA revC))
(fileB fileC))
(if (and magit-ediff-show-stash-with-index
(member fileA (magit-changed-files revB revA)))
(magit-ediff-buffers nil
((magit-get-revision-buffer revA fileA)
(magit-find-file-noselect revA fileA))
((magit-get-revision-buffer revB fileB)
(magit-find-file-noselect revB fileB))
((magit-get-revision-buffer revC fileC)
(magit-find-file-noselect revC fileC)))
(magit-ediff-compare revA revC fileA fileC))))
(defun magit-ediff-cleanup-auxiliary-buffers ()
(let* ((ctl-buf ediff-control-buffer)
(ctl-win (ediff-get-visible-buffer-window ctl-buf))
(ctl-frm ediff-control-frame)
(main-frame (cond ((window-live-p ediff-window-A)
(window-frame ediff-window-A))
((window-live-p ediff-window-B)
(window-frame ediff-window-B)))))
(ediff-kill-buffer-carefully ediff-diff-buffer)
(ediff-kill-buffer-carefully ediff-custom-diff-buffer)
(ediff-kill-buffer-carefully ediff-fine-diff-buffer)
(ediff-kill-buffer-carefully ediff-tmp-buffer)
(ediff-kill-buffer-carefully ediff-error-buffer)
(ediff-kill-buffer-carefully ediff-msg-buffer)
(ediff-kill-buffer-carefully ediff-debug-buffer)
(when (boundp 'ediff-patch-diagnostics)
(ediff-kill-buffer-carefully ediff-patch-diagnostics))
(cond ((and (ediff-window-display-p)
(frame-live-p ctl-frm))
(delete-frame ctl-frm))
((window-live-p ctl-win)
(delete-window ctl-win)))
(ediff-kill-buffer-carefully ctl-buf)
(when (frame-live-p main-frame)
(select-frame main-frame))))
(defun magit-ediff-restore-previous-winconf ()
(set-window-configuration magit-ediff-previous-winconf))
;;; _
(provide 'magit-ediff)
;;; magit-ediff.el ends here

916
code/elpa/magit-20220425.1153/magit-extras.el Normal file
View file

@ -0,0 +1,916 @@
;;; magit-extras.el --- Additional functionality for Magit -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Additional functionality for Magit.
;;; Code:
(require 'magit)
;; For `magit-do-async-shell-command'.
(declare-function dired-read-shell-command "dired-aux" (prompt arg files))
;; For `magit-project-status'.
(declare-function vc-git-command "vc-git"
(buffer okstatus file-or-list &rest flags))
(defvar ido-exit)
(defvar ido-fallback)
(defvar project-prefix-map)
(defvar project-switch-commands)
(defgroup magit-extras nil
"Additional functionality for Magit."
:group 'magit-extensions)
;;; Git Tools
;;;; Git-Mergetool
;;;###autoload (autoload 'magit-git-mergetool "magit-extras" nil t)
(transient-define-prefix magit-git-mergetool (file args &optional transient)
"Resolve conflicts in FILE using \"git mergetool --gui\".
With a prefix argument allow changing ARGS using a transient
popup."
:man-page "git-mergetool"
["Settings"
("-t" magit-git-mergetool:--tool)
("=t" magit-merge.guitool)
("=T" magit-merge.tool)
("-r" magit-mergetool.hideResolved)
("-b" magit-mergetool.keepBackup)
("-k" magit-mergetool.keepTemporaries)
("-w" magit-mergetool.writeToTemp)]
["Actions"
(" m" "Invoke mergetool" magit-git-mergetool)]
(interactive
(if (and (not (eq transient-current-prefix 'magit-git-mergetool))
current-prefix-arg)
(list nil nil t)
(list (magit-read-unmerged-file "Resolve")
(transient-args 'magit-git-mergetool))))
(if transient
(transient-setup 'magit-git-mergetool)
(magit-run-git-async "mergetool" "--gui" args "--" file)))
(transient-define-infix magit-git-mergetool:--tool ()
:description "Override mergetool"
:class 'transient-option
:shortarg "-t"
:argument "--tool="
:reader #'magit--read-mergetool)
(transient-define-infix magit-merge.guitool ()
:class 'magit--git-variable
:variable "merge.guitool"
:global t
:reader #'magit--read-mergetool)
(transient-define-infix magit-merge.tool ()
:class 'magit--git-variable
:variable "merge.tool"
:global t
:reader #'magit--read-mergetool)
(defun magit--read-mergetool (prompt _initial-input history)
(let ((choices nil)
(lines (cdr (magit-git-lines "mergetool" "--tool-help"))))
(while (string-prefix-p "\t\t" (car lines))
(push (substring (pop lines) 2) choices))
(setq choices (nreverse choices))
(magit-completing-read (or prompt "Select mergetool")
choices nil t nil history)))
(transient-define-infix magit-mergetool.hideResolved ()
:class 'magit--git-variable:boolean
:variable "mergetool.hideResolved"
:default "false"
:global t)
(transient-define-infix magit-mergetool.keepBackup ()
:class 'magit--git-variable:boolean
:variable "mergetool.keepBackup"
:default "true"
:global t)
(transient-define-infix magit-mergetool.keepTemporaries ()
:class 'magit--git-variable:boolean
:variable "mergetool.keepTemporaries"
:default "false"
:global t)
(transient-define-infix magit-mergetool.writeToTemp ()
:class 'magit--git-variable:boolean
:variable "mergetool.writeToTemp"
:default "false"
:global t)
;;;; Git-Gui
;;;###autoload
(defun magit-run-git-gui-blame (commit filename &optional linenum)
"Run `git gui blame' on the given FILENAME and COMMIT.
Interactively run it for the current file and the `HEAD', with a
prefix or when the current file cannot be determined let the user
choose. When the current buffer is visiting FILENAME instruct
blame to center around the line point is on."
(interactive
(let (revision filename)
(when (or current-prefix-arg
(not (setq revision "HEAD"
filename (magit-file-relative-name nil 'tracked))))
(setq revision (magit-read-branch-or-commit "Blame from revision"))
(setq filename (magit-read-file-from-rev revision "Blame file")))
(list revision filename
(and (equal filename
(ignore-errors
(magit-file-relative-name buffer-file-name)))
(line-number-at-pos)))))
(magit-with-toplevel
(magit-process-git 0 "gui" "blame"
(and linenum (list (format "--line=%d" linenum)))
commit
filename)))
;;;; Gitk
(defcustom magit-gitk-executable
(or (and (eq system-type 'windows-nt)
(let ((exe (magit-git-string
"-c" "alias.X=!x() { which \"$1\" | cygpath -mf -; }; x"
"X" "gitk.exe")))
(and exe (file-executable-p exe) exe)))
(executable-find "gitk") "gitk")
"The Gitk executable."
:group 'magit-extras
:set-after '(magit-git-executable)
:type 'string)
;;;###autoload
(defun magit-run-git-gui ()
"Run `git gui' for the current git repository."
(interactive)
(magit-with-toplevel (magit-process-git 0 "gui")))
;;;###autoload
(defun magit-run-gitk ()
"Run `gitk' in the current repository."
(interactive)
(magit-process-file magit-gitk-executable nil 0))
;;;###autoload
(defun magit-run-gitk-branches ()
"Run `gitk --branches' in the current repository."
(interactive)
(magit-process-file magit-gitk-executable nil 0 nil "--branches"))
;;;###autoload
(defun magit-run-gitk-all ()
"Run `gitk --all' in the current repository."
(interactive)
(magit-process-file magit-gitk-executable nil 0 nil "--all"))
;;; Emacs Tools
;;;###autoload
(defun ido-enter-magit-status ()
"Drop into `magit-status' from file switching.
This command does not work in Emacs 26.1.
See https://github.com/magit/magit/issues/3634
and https://debbugs.gnu.org/cgi/bugreport.cgi?bug=31707.
To make this command available use something like:
(add-hook \\='ido-setup-hook
(lambda ()
(define-key ido-completion-map
(kbd \"C-x g\") \\='ido-enter-magit-status)))
Starting with Emacs 25.1 the Ido keymaps are defined just once
instead of every time Ido is invoked, so now you can modify it
like pretty much every other keymap:
(define-key ido-common-completion-map
(kbd \"C-x g\") \\='ido-enter-magit-status)"
(interactive)
(setq ido-exit 'fallback)
(setq ido-fallback #'magit-status) ; for Emacs >= 26.2
(with-no-warnings (setq fallback #'magit-status)) ; for Emacs 25
(exit-minibuffer))
;;;###autoload
(defun magit-project-status ()
"Run `magit-status' in the current project's root."
(interactive)
(if (fboundp 'project-root)
(magit-status-setup-buffer (project-root (project-current t)))
(user-error "`magit-project-status' requires `project' 0.3.0 or greater")))
(defvar magit-bind-magit-project-status t
"Whether to bind \"m\" to `magit-project-status' in `project-prefix-map'.
If so, then an entry is added to `project-switch-commands' as
well. If you want to use another key, then you must set this
to nil before loading Magit to prevent \"m\" from being bound.")
(with-eval-after-load 'project
;; Only more recent versions of project.el have `project-prefix-map' and
;; `project-switch-commands', though project.el is available in Emacs 25.
(when (and magit-bind-magit-project-status
(boundp 'project-prefix-map)
;; Only modify if it hasn't already been modified.
(equal project-switch-commands
(eval (car (get 'project-switch-commands 'standard-value))
t)))
(define-key project-prefix-map "m" #'magit-project-status)
(add-to-list 'project-switch-commands '(magit-project-status "Magit") t)))
;;;###autoload
(defun magit-dired-jump (&optional other-window)
"Visit file at point using Dired.
With a prefix argument, visit in another window. If there
is no file at point, then instead visit `default-directory'."
(interactive "P")
(dired-jump other-window
(and-let* ((file (magit-file-at-point)))
(expand-file-name (if (file-directory-p file)
(file-name-as-directory file)
file)))))
;;;###autoload
(defun magit-dired-log (&optional follow)
"Show log for all marked files, or the current file."
(interactive "P")
(if-let ((topdir (magit-toplevel default-directory)))
(let ((args (car (magit-log-arguments)))
(files (compat-dired-get-marked-files
nil nil #'magit-file-tracked-p nil
"No marked file is being tracked by Git")))
(when (and follow
(not (member "--follow" args))
(not (cdr files)))
(push "--follow" args))
(magit-log-setup-buffer
(list (or (magit-get-current-branch) "HEAD"))
args
(let ((default-directory topdir))
(mapcar #'file-relative-name files))
magit-log-buffer-file-locked))
(magit--not-inside-repository-error)))
;;;###autoload
(defun magit-dired-am-apply-patches (repo &optional arg)
"In Dired, apply the marked (or next ARG) files as patches.
If inside a repository, then apply in that. Otherwise prompt
for a repository."
(interactive (list (or (magit-toplevel)
(magit-read-repository t))
current-prefix-arg))
(let ((files (compat-dired-get-marked-files nil arg nil nil t)))
(magit-status-setup-buffer repo)
(magit-am-apply-patches files)))
;;;###autoload
(defun magit-do-async-shell-command (file)
"Open FILE with `dired-do-async-shell-command'.
Interactively, open the file at point."
(interactive (list (or (magit-file-at-point)
(completing-read "Act on file: "
(magit-list-files)))))
(require 'dired-aux)
(dired-do-async-shell-command
(dired-read-shell-command "& on %s: " current-prefix-arg (list file))
nil (list file)))
;;; Shift Selection
(defun magit--turn-on-shift-select-mode-p ()
(and shift-select-mode
this-command-keys-shift-translated
(not mark-active)
(not (eq (car-safe transient-mark-mode) 'only))))
;;;###autoload
(defun magit-previous-line (&optional arg try-vscroll)
"Like `previous-line' but with Magit-specific shift-selection.
Magit's selection mechanism is based on the region but selects an
area that is larger than the region. This causes `previous-line'
when invoked while holding the shift key to move up one line and
thereby select two lines. When invoked inside a hunk body this
command does not move point on the first invocation and thereby
it only selects a single line. Which inconsistency you prefer
is a matter of preference."
(declare (interactive-only
"use `forward-line' with negative argument instead."))
(interactive "p\np")
(unless arg (setq arg 1))
(let ((stay (or (magit-diff-inside-hunk-body-p)
(magit-section-position-in-heading-p))))
(if (and stay (= arg 1) (magit--turn-on-shift-select-mode-p))
(push-mark nil nil t)
(with-no-warnings
(handle-shift-selection)
(previous-line (if stay (max (1- arg) 1) arg) try-vscroll)))))
;;;###autoload
(defun magit-next-line (&optional arg try-vscroll)
"Like `next-line' but with Magit-specific shift-selection.
Magit's selection mechanism is based on the region but selects
an area that is larger than the region. This causes `next-line'
when invoked while holding the shift key to move down one line
and thereby select two lines. When invoked inside a hunk body
this command does not move point on the first invocation and
thereby it only selects a single line. Which inconsistency you
prefer is a matter of preference."
(declare (interactive-only forward-line))
(interactive "p\np")
(unless arg (setq arg 1))
(let ((stay (or (magit-diff-inside-hunk-body-p)
(magit-section-position-in-heading-p))))
(if (and stay (= arg 1) (magit--turn-on-shift-select-mode-p))
(push-mark nil nil t)
(with-no-warnings
(handle-shift-selection)
(next-line (if stay (max (1- arg) 1) arg) try-vscroll)))))
;;; Clean
;;;###autoload
(defun magit-clean (&optional arg)
"Remove untracked files from the working tree.
With a prefix argument also remove ignored files,
with two prefix arguments remove ignored files only.
\n(git clean -f -d [-x|-X])"
(interactive "p")
(when (yes-or-no-p (format "Remove %s files? "
(pcase arg
(1 "untracked")
(4 "untracked and ignored")
(_ "ignored"))))
(magit-wip-commit-before-change)
(magit-run-git "clean" "-f" "-d" (pcase arg (4 "-x") (16 "-X")))))
(put 'magit-clean 'disabled t)
;;; ChangeLog
;;;###autoload
(defun magit-generate-changelog (&optional amending)
"Insert ChangeLog entries into the current buffer.
The entries are generated from the diff being committed.
If prefix argument, AMENDING, is non-nil, include changes
in HEAD as well as staged changes in the diff to check."
(interactive "P")
(unless (magit-commit-message-buffer)
(user-error "No commit in progress"))
(require 'diff-mode) ; `diff-add-log-current-defuns'.
(require 'vc-git) ; `vc-git-diff'.
(require 'add-log) ; `change-log-insert-entries'.
(cond
((and (fboundp 'change-log-insert-entries)
(fboundp 'diff-add-log-current-defuns))
(setq default-directory
(if (and (file-regular-p "gitdir")
(not (magit-git-true "rev-parse" "--is-inside-work-tree"))
(magit-git-true "rev-parse" "--is-inside-git-dir"))
(file-name-directory (magit-file-line "gitdir"))
(magit-toplevel)))
(let ((rev1 (if amending "HEAD^1" "HEAD"))
(rev2 nil))
;; Magit may have updated the files without notifying vc, but
;; `diff-add-log-current-defuns' relies on vc being up-to-date.
(mapc #'vc-file-clearprops (magit-staged-files))
(change-log-insert-entries
(with-temp-buffer
(vc-git-command (current-buffer) 1 nil
"diff-index" "--exit-code" "--patch"
(and (magit-anything-staged-p) "--cached")
rev1 "--")
;; `diff-find-source-location' consults these vars.
(defvar diff-vc-revisions)
(setq-local diff-vc-revisions (list rev1 rev2))
(setq-local diff-vc-backend 'Git)
(diff-add-log-current-defuns)))))
(t (user-error "`magit-generate-changelog' requires Emacs 27 or greater"))))
;;;###autoload
(defun magit-add-change-log-entry (&optional whoami file-name other-window)
"Find change log file and add date entry and item for current change.
This differs from `add-change-log-entry' (which see) in that
it acts on the current hunk in a Magit buffer instead of on
a position in a file-visiting buffer."
(interactive (list current-prefix-arg
(prompt-for-change-log-name)))
(pcase-let ((`(,buf ,pos) (magit-diff-visit-file--noselect)))
(magit--with-temp-position buf pos
(let ((add-log-buffer-file-name-function
(lambda ()
(or magit-buffer-file-name
(buffer-file-name)))))
(add-change-log-entry whoami file-name other-window)))))
;;;###autoload
(defun magit-add-change-log-entry-other-window (&optional whoami file-name)
"Find change log file in other window and add entry and item.
This differs from `add-change-log-entry-other-window' (which see)
in that it acts on the current hunk in a Magit buffer instead of
on a position in a file-visiting buffer."
(interactive (and current-prefix-arg
(list current-prefix-arg
(prompt-for-change-log-name))))
(magit-add-change-log-entry whoami file-name t))
;;; Edit Line Commit
;;;###autoload
(defun magit-edit-line-commit (&optional type)
"Edit the commit that added the current line.
With a prefix argument edit the commit that removes the line,
if any. The commit is determined using `git blame' and made
editable using `git rebase --interactive' if it is reachable
from `HEAD', or by checking out the commit (or a branch that
points at it) otherwise."
(interactive (list (and current-prefix-arg 'removal)))
(let* ((chunk (magit-current-blame-chunk (or type 'addition)))
(rev (oref chunk orig-rev)))
(if (string-match-p "\\`0\\{40,\\}\\'" rev)
(message "This line has not been committed yet")
(let ((rebase (magit-rev-ancestor-p rev "HEAD"))
(file (expand-file-name (oref chunk orig-file)
(magit-toplevel))))
(if rebase
(let ((magit--rebase-published-symbol 'edit-published))
(magit-rebase-edit-commit rev (magit-rebase-arguments)))
(magit-checkout (or (magit-rev-branch rev) rev)))
(unless (and buffer-file-name
(file-equal-p file buffer-file-name))
(let ((blame-type (and magit-blame-mode magit-blame-type)))
(if rebase
(set-process-sentinel
magit-this-process
(lambda (process event)
(magit-sequencer-process-sentinel process event)
(when (eq (process-status process) 'exit)
(find-file file)
(when blame-type
(magit-blame--pre-blame-setup blame-type)
(magit-blame--run (magit-blame-arguments))))))
(find-file file)
(when blame-type
(magit-blame--pre-blame-setup blame-type)
(magit-blame--run (magit-blame-arguments))))))))))
(put 'magit-edit-line-commit 'disabled t)
;;;###autoload
(defun magit-diff-edit-hunk-commit (file)
"From a hunk, edit the respective commit and visit the file.
First visit the file being modified by the hunk at the correct
location using `magit-diff-visit-file'. This actually visits a
blob. When point is on a diff header, not within an individual
hunk, then this visits the blob the first hunk is about.
Then invoke `magit-edit-line-commit', which uses an interactive
rebase to make the commit editable, or if that is not possible
because the commit is not reachable from `HEAD' by checking out
that commit directly. This also causes the actual worktree file
to be visited.
Neither the blob nor the file buffer are killed when finishing
the rebase. If that is undesirable, then it might be better to
use `magit-rebase-edit-command' instead of this command."
(interactive (list (magit-file-at-point t t)))
(let ((magit-diff-visit-previous-blob nil))
(with-current-buffer
(magit-diff-visit-file--internal file nil #'pop-to-buffer-same-window)
(magit-edit-line-commit))))
(put 'magit-diff-edit-hunk-commit 'disabled t)
;;; Reshelve
(defcustom magit-reshelve-since-committer-only nil
"Whether `magit-reshelve-since' changes only the committer dates.
Otherwise the author dates are also changed."
:package-version '(magit . "3.0.0")
:group 'magit-commands
:type 'boolean)
;;;###autoload
(defun magit-reshelve-since (rev keyid)
"Change the author and committer dates of the commits since REV.
Ask the user for the first reachable commit whose dates should
be changed. Then read the new date for that commit. The initial
minibuffer input and the previous history element offer good
values. The next commit will be created one minute later and so
on.
This command is only intended for interactive use and should only
be used on highly rearranged and unpublished history.
If KEYID is non-nil, then use that to sign all reshelved commits.
Interactively use the value of the \"--gpg-sign\" option in the
list returned by `magit-rebase-arguments'."
(interactive (list nil
(transient-arg-value "--gpg-sign="
(magit-rebase-arguments))))
(let* ((current (or (magit-get-current-branch)
(user-error "Refusing to reshelve detached head")))
(backup (concat "refs/original/refs/heads/" current)))
(cond
((not rev)
(when (and (magit-ref-p backup)
(not (magit-y-or-n-p
(format "Backup ref %s already exists. Override? " backup))))
(user-error "Abort"))
(magit-log-select
(lambda (rev)
(magit-reshelve-since rev keyid))
"Type %p on a commit to reshelve it and the commits above it,"))
(t
(cl-flet ((adjust (time offset)
(format-time-string
"%F %T %z"
(+ (floor time)
(* offset 60)
(- (car (decode-time time)))))))
(let* ((start (concat rev "^"))
(range (concat start ".." current))
(time-rev (adjust (float-time (string-to-number
(magit-rev-format "%at" start)))
1))
(time-now (adjust (float-time)
(- (string-to-number
(magit-git-string "rev-list" "--count"
range))))))
(push time-rev magit--reshelve-history)
(let ((date (floor
(float-time
(date-to-time
(read-string "Date for first commit: "
time-now 'magit--reshelve-history))))))
(with-environment-variables (("FILTER_BRANCH_SQUELCH_WARNING" "1"))
(magit-with-toplevel
(magit-run-git-async
"filter-branch" "--force" "--env-filter"
(format
"case $GIT_COMMIT in %s\nesac"
(mapconcat
(lambda (rev)
(prog1
(concat
(format "%s) " rev)
(and (not magit-reshelve-since-committer-only)
(format "export GIT_AUTHOR_DATE=\"%s\"; " date))
(format "export GIT_COMMITTER_DATE=\"%s\";;" date))
(cl-incf date 60)))
(magit-git-lines "rev-list" "--reverse" range)
" "))
(and keyid
(list "--commit-filter"
(format "git commit-tree --gpg-sign=%s \"$@\";"
keyid)))
range "--"))
(set-process-sentinel
magit-this-process
(lambda (process event)
(when (memq (process-status process) '(exit signal))
(if (> (process-exit-status process) 0)
(magit-process-sentinel process event)
(process-put process 'inhibit-refresh t)
(magit-process-sentinel process event)
(magit-run-git "update-ref" "-d" backup)))))))))))))
;;; Revision Stack
(defvar magit-revision-stack nil)
(defcustom magit-pop-revision-stack-format
'("[%N: %h] "
"%N: %cs %H\n %s\n"
"\\[\\([0-9]+\\)[]:]")
"Control how `magit-pop-revision-stack' inserts a revision.
The command `magit-pop-revision-stack' inserts a representation
of the revision last pushed to the `magit-revision-stack' into
the current buffer. It inserts text at point and/or near the end
of the buffer, and removes the consumed revision from the stack.
The entries on the stack have the format (HASH TOPLEVEL) and this
option has the format (POINT-FORMAT EOB-FORMAT INDEX-REGEXP), all
of which may be nil or a string (though either one of EOB-FORMAT
or POINT-FORMAT should be a string, and if INDEX-REGEXP is
non-nil, then the two formats should be too).
First INDEX-REGEXP is used to find the previously inserted entry,
by searching backward from point. The first submatch must match
the index number. That number is incremented by one, and becomes
the index number of the entry to be inserted. If you don't want
to number the inserted revisions, then use nil for INDEX-REGEXP.
If INDEX-REGEXP is non-nil, then both POINT-FORMAT and EOB-FORMAT
should contain \"%N\", which is replaced with the number that was
determined in the previous step.
Both formats, if non-nil and after removing %N, are then expanded
using `git show --format=FORMAT ...' inside TOPLEVEL.
The expansion of POINT-FORMAT is inserted at point, and the
expansion of EOB-FORMAT is inserted at the end of the buffer (if
the buffer ends with a comment, then it is inserted right before
that)."
:package-version '(magit . "3.2.0")
:group 'magit-commands
:type '(list (choice (string :tag "Insert at point format")
(cons (string :tag "Insert at point format")
(repeat (string :tag "Argument to git show")))
(const :tag "Don't insert at point" nil))
(choice (string :tag "Insert at eob format")
(cons (string :tag "Insert at eob format")
(repeat (string :tag "Argument to git show")))
(const :tag "Don't insert at eob" nil))
(choice (regexp :tag "Find index regexp")
(const :tag "Don't number entries" nil))))
(defcustom magit-copy-revision-abbreviated nil
"Whether to save abbreviated revision to `kill-ring' and `magit-revision-stack'."
:package-version '(magit . "3.0.0")
:group 'magit-miscellaneous
:type 'boolean)
;;;###autoload
(defun magit-pop-revision-stack (rev toplevel)
"Insert a representation of a revision into the current buffer.
Pop a revision from the `magit-revision-stack' and insert it into
the current buffer according to `magit-pop-revision-stack-format'.
Revisions can be put on the stack using `magit-copy-section-value'
and `magit-copy-buffer-revision'.
If the stack is empty or with a prefix argument, instead read a
revision in the minibuffer. By using the minibuffer history this
allows selecting an item which was popped earlier or to insert an
arbitrary reference or revision without first pushing it onto the
stack.
When reading the revision from the minibuffer, then it might not
be possible to guess the correct repository. When this command
is called inside a repository (e.g. while composing a commit
message), then that repository is used. Otherwise (e.g. while
composing an email) then the repository recorded for the top
element of the stack is used (even though we insert another
revision). If not called inside a repository and with an empty
stack, or with two prefix arguments, then read the repository in
the minibuffer too."
(interactive
(if (or current-prefix-arg (not magit-revision-stack))
(let ((default-directory
(or (and (not (= (prefix-numeric-value current-prefix-arg) 16))
(or (magit-toplevel)
(cadr (car magit-revision-stack))))
(magit-read-repository))))
(list (magit-read-branch-or-commit "Insert revision")
default-directory))
(push (caar magit-revision-stack) magit-revision-history)
(pop magit-revision-stack)))
(if rev
(pcase-let ((`(,pnt-format ,eob-format ,idx-format)
magit-pop-revision-stack-format))
(let ((default-directory toplevel)
(idx (and idx-format
(save-excursion
(if (re-search-backward idx-format nil t)
(number-to-string
(1+ (string-to-number (match-string 1))))
"1"))))
pnt-args eob-args)
(when (listp pnt-format)
(setq pnt-args (cdr pnt-format))
(setq pnt-format (car pnt-format)))
(when (listp eob-format)
(setq eob-args (cdr eob-format))
(setq eob-format (car eob-format)))
(when pnt-format
(when idx-format
(setq pnt-format
(string-replace "%N" idx pnt-format)))
(magit-rev-insert-format pnt-format rev pnt-args)
(backward-delete-char 1))
(when eob-format
(when idx-format
(setq eob-format
(string-replace "%N" idx eob-format)))
(save-excursion
(goto-char (point-max))
(skip-syntax-backward ">s-")
(beginning-of-line)
(if (and comment-start (looking-at comment-start))
(while (looking-at comment-start)
(forward-line -1))
(forward-line)
(unless (= (current-column) 0)
(insert ?\n)))
(insert ?\n)
(magit-rev-insert-format eob-format rev eob-args)
(backward-delete-char 1)))))
(user-error "Revision stack is empty")))
(define-key git-commit-mode-map
(kbd "C-c C-w") #'magit-pop-revision-stack)
;;;###autoload
(defun magit-copy-section-value (arg)
"Save the value of the current section for later use.
Save the section value to the `kill-ring', and, provided that
the current section is a commit, branch, or tag section, push
the (referenced) revision to the `magit-revision-stack' for use
with `magit-pop-revision-stack'.
When `magit-copy-revision-abbreviated' is non-nil, save the
abbreviated revision to the `kill-ring' and the
`magit-revision-stack'.
When the current section is a branch or a tag, and a prefix
argument is used, then save the revision at its tip to the
`kill-ring' instead of the reference name.
When the region is active, then save that to the `kill-ring',
like `kill-ring-save' would, instead of behaving as described
above. If a prefix argument is used and the region is within
a hunk, then strip the diff marker column and keep only either
the added or removed lines, depending on the sign of the prefix
argument."
(interactive "P")
(cond
((and arg
(magit-section-internal-region-p)
(magit-section-match 'hunk))
(kill-new
(thread-last (buffer-substring-no-properties
(region-beginning)
(region-end))
(replace-regexp-in-string
(format "^\\%c.*\n?" (if (< (prefix-numeric-value arg) 0) ?+ ?-))
"")
(replace-regexp-in-string "^[ \\+\\-]" "")))
(deactivate-mark))
((use-region-p)
(call-interactively #'copy-region-as-kill))
(t
(when-let* ((section (magit-current-section))
(value (oref section value)))
(magit-section-case
((branch commit module-commit tag)
(let ((default-directory default-directory) ref)
(magit-section-case
((branch tag)
(setq ref value))
(module-commit
(setq default-directory
(file-name-as-directory
(expand-file-name (magit-section-parent-value section)
(magit-toplevel))))))
(setq value (magit-rev-parse
(and magit-copy-revision-abbreviated "--short")
value))
(push (list value default-directory) magit-revision-stack)
(kill-new (message "%s" (or (and current-prefix-arg ref)
value)))))
(t (kill-new (message "%s" value))))))))
;;;###autoload
(defun magit-copy-buffer-revision ()
"Save the revision of the current buffer for later use.
Save the revision shown in the current buffer to the `kill-ring'
and push it to the `magit-revision-stack'.
This command is mainly intended for use in `magit-revision-mode'
buffers, the only buffers where it is always unambiguous exactly
which revision should be saved.
Most other Magit buffers usually show more than one revision, in
some way or another, so this command has to select one of them,
and that choice might not always be the one you think would have
been the best pick.
In such buffers it is often more useful to save the value of
the current section instead, using `magit-copy-section-value'.
When the region is active, then save that to the `kill-ring',
like `kill-ring-save' would, instead of behaving as described
above.
When `magit-copy-revision-abbreviated' is non-nil, save the
abbreviated revision to the `kill-ring' and the
`magit-revision-stack'."
(interactive)
(if (use-region-p)
(call-interactively #'copy-region-as-kill)
(when-let ((rev (or magit-buffer-revision
(cl-case major-mode
(magit-diff-mode
(if (string-match "\\.\\.\\.?\\(.+\\)"
magit-buffer-range)
(match-string 1 magit-buffer-range)
magit-buffer-range))
(magit-status-mode "HEAD")))))
(when (magit-commit-p rev)
(setq rev (magit-rev-parse
(and magit-copy-revision-abbreviated "--short")
rev))
(push (list rev default-directory) magit-revision-stack)
(kill-new (message "%s" rev))))))
;;; Buffer Switching
;;;###autoload
(defun magit-display-repository-buffer (buffer)
"Display a Magit buffer belonging to the current Git repository.
The buffer is displayed using `magit-display-buffer', which see."
(interactive (list (magit--read-repository-buffer
"Display magit buffer: ")))
(magit-display-buffer buffer))
;;;###autoload
(defun magit-switch-to-repository-buffer (buffer)
"Switch to a Magit buffer belonging to the current Git repository."
(interactive (list (magit--read-repository-buffer
"Switch to magit buffer: ")))
(switch-to-buffer buffer))
;;;###autoload
(defun magit-switch-to-repository-buffer-other-window (buffer)
"Switch to a Magit buffer belonging to the current Git repository."
(interactive (list (magit--read-repository-buffer
"Switch to magit buffer in another window: ")))
(switch-to-buffer-other-window buffer))
;;;###autoload
(defun magit-switch-to-repository-buffer-other-frame (buffer)
"Switch to a Magit buffer belonging to the current Git repository."
(interactive (list (magit--read-repository-buffer
"Switch to magit buffer in another frame: ")))
(switch-to-buffer-other-frame buffer))
(defun magit--read-repository-buffer (prompt)
(if-let ((topdir (magit-rev-parse-safe "--show-toplevel")))
(read-buffer
prompt (magit-get-mode-buffer 'magit-status-mode) t
(pcase-lambda (`(,_ . ,buf))
(and buf
(with-current-buffer buf
(and (or (derived-mode-p 'magit-mode
'magit-repolist-mode
'magit-submodule-list-mode
'git-rebase-mode)
(and buffer-file-name
(string-match-p git-commit-filename-regexp
buffer-file-name)))
(equal (magit-rev-parse-safe "--show-toplevel")
topdir))))))
(user-error "Not inside a Git repository")))
;;; Miscellaneous
;;;###autoload
(defun magit-abort-dwim ()
"Abort current operation.
Depending on the context, this will abort a merge, a rebase, a
patch application, a cherry-pick, a revert, or a bisect."
(interactive)
(cond ((magit-merge-in-progress-p) (magit-merge-abort))
((magit-rebase-in-progress-p) (magit-rebase-abort))
((magit-am-in-progress-p) (magit-am-abort))
((magit-sequencer-in-progress-p) (magit-sequencer-abort))
((magit-bisect-in-progress-p) (magit-bisect-reset))))
;;; _
(provide 'magit-extras)
;;; magit-extras.el ends here

199
code/elpa/magit-20220425.1153/magit-fetch.el Normal file
View file

@ -0,0 +1,199 @@
;;; magit-fetch.el --- Download objects and refs -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library implements fetch commands.
;;; Code:
(require 'magit)
(defvar magit-fetch-modules-jobs nil)
(make-obsolete-variable
'magit-fetch-modules-jobs
"invoke `magit-fetch-modules' with a prefix argument instead."
"Magit 3.0.0")
;;; Commands
;;;###autoload (autoload 'magit-fetch "magit-fetch" nil t)
(transient-define-prefix magit-fetch ()
"Fetch from another repository."
:man-page "git-fetch"
["Arguments"
("-p" "Prune deleted branches" ("-p" "--prune"))
("-t" "Fetch all tags" ("-t" "--tags"))
(7 "-u" "Fetch full history" "--unshallow")]
["Fetch from"
("p" magit-fetch-from-pushremote)
("u" magit-fetch-from-upstream)
("e" "elsewhere" magit-fetch-other)
("a" "all remotes" magit-fetch-all)]
["Fetch"
("o" "another branch" magit-fetch-branch)
("r" "explicit refspec" magit-fetch-refspec)
("m" "submodules" magit-fetch-modules)]
["Configure"
("C" "variables..." magit-branch-configure)])
(defun magit-fetch-arguments ()
(transient-args 'magit-fetch))
(defun magit-git-fetch (remote args)
(run-hooks 'magit-credential-hook)
(magit-run-git-async "fetch" remote args))
;;;###autoload (autoload 'magit-fetch-from-pushremote "magit-fetch" nil t)
(transient-define-suffix magit-fetch-from-pushremote (args)
"Fetch from the current push-remote.
With a prefix argument or when the push-remote is either not
configured or unusable, then let the user first configure the
push-remote."
:description #'magit-fetch--pushremote-description
(interactive (list (magit-fetch-arguments)))
(let ((remote (magit-get-push-remote)))
(when (or current-prefix-arg
(not (member remote (magit-list-remotes))))
(let ((var (magit--push-remote-variable)))
(setq remote
(magit-read-remote (format "Set %s and fetch from there" var)))
(magit-set remote var)))
(magit-git-fetch remote args)))
(defun magit-fetch--pushremote-description ()
(let* ((branch (magit-get-current-branch))
(remote (magit-get-push-remote branch))
(v (magit--push-remote-variable branch t)))
(cond
((member remote (magit-list-remotes)) remote)
(remote
(format "%s, replacing invalid" v))
(t
(format "%s, setting that" v)))))
;;;###autoload (autoload 'magit-fetch-from-upstream "magit-fetch" nil t)
(transient-define-suffix magit-fetch-from-upstream (remote args)
"Fetch from the \"current\" remote, usually the upstream.
If the upstream is configured for the current branch and names
an existing remote, then use that. Otherwise try to use another
remote: If only a single remote is configured, then use that.
Otherwise if a remote named \"origin\" exists, then use that.
If no remote can be determined, then this command is not available
from the `magit-fetch' transient prefix and invoking it directly
results in an error."
:if (lambda () (magit-get-current-remote t))
:description (lambda () (magit-get-current-remote t))
(interactive (list (magit-get-current-remote t)
(magit-fetch-arguments)))
(unless remote
(error "The \"current\" remote could not be determined"))
(magit-git-fetch remote args))
;;;###autoload
(defun magit-fetch-other (remote args)
"Fetch from another repository."
(interactive (list (magit-read-remote "Fetch remote")
(magit-fetch-arguments)))
(magit-git-fetch remote args))
;;;###autoload
(defun magit-fetch-branch (remote branch args)
"Fetch a BRANCH from a REMOTE."
(interactive
(let ((remote (magit-read-remote-or-url "Fetch from remote or url")))
(list remote
(magit-read-remote-branch "Fetch branch" remote)
(magit-fetch-arguments))))
(magit-git-fetch remote (cons branch args)))
;;;###autoload
(defun magit-fetch-refspec (remote refspec args)
"Fetch a REFSPEC from a REMOTE."
(interactive
(let ((remote (magit-read-remote-or-url "Fetch from remote or url")))
(list remote
(magit-read-refspec "Fetch using refspec" remote)
(magit-fetch-arguments))))
(magit-git-fetch remote (cons refspec args)))
;;;###autoload
(defun magit-fetch-all (args)
"Fetch from all remotes."
(interactive (list (magit-fetch-arguments)))
(magit-git-fetch nil (cons "--all" args)))
;;;###autoload
(defun magit-fetch-all-prune ()
"Fetch from all remotes, and prune.
Prune remote tracking branches for branches that have been
removed on the respective remote."
(interactive)
(run-hooks 'magit-credential-hook)
(magit-run-git-async "remote" "update" "--prune"))
;;;###autoload
(defun magit-fetch-all-no-prune ()
"Fetch from all remotes."
(interactive)
(run-hooks 'magit-credential-hook)
(magit-run-git-async "remote" "update"))
;;;###autoload (autoload 'magit-fetch-modules "magit-fetch" nil t)
(transient-define-prefix magit-fetch-modules (&optional transient args)
"Fetch all submodules.
Fetching is done using \"git fetch --recurse-submodules\", which
means that the super-repository and recursively all submodules
are also fetched.
To set and potentially save other arguments invoke this command
with a prefix argument."
:man-page "git-fetch"
:value (list "--verbose"
(cond (magit-fetch-modules-jobs
(format "--jobs=%s" magit-fetch-modules-jobs))
(t "--jobs=4")))
["Arguments"
("-v" "verbose" "--verbose")
("-j" "number of jobs" "--jobs=" :reader transient-read-number-N+)]
["Action"
("m" "fetch modules" magit-fetch-modules)]
(interactive (if current-prefix-arg
(list t)
(list nil (transient-args 'magit-fetch-modules))))
(if transient
(transient-setup 'magit-fetch-modules)
(when (magit-git-version< "2.8.0")
(when-let ((value (transient-arg-value "--jobs=" args)))
(message "Dropping --jobs; not supported by Git v%s"
(magit-git-version))
(setq args (remove (format "--jobs=%s" value) args))))
(magit-with-toplevel
(magit-run-git-async "fetch" "--recurse-submodules" args))))
;;; _
(provide 'magit-fetch)
;;; magit-fetch.el ends here

535
code/elpa/magit-20220425.1153/magit-files.el Normal file
View file

@ -0,0 +1,535 @@
;;; magit-files.el --- Finding files -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library implements support for finding blobs, staged files,
;; and Git configuration files. It also implements modes useful in
;; buffers visiting files and blobs, and the commands used by those
;; modes.
;;; Code:
(require 'magit)
;;; Find Blob
(defvar magit-find-file-hook nil)
(add-hook 'magit-find-file-hook #'magit-blob-mode)
;;;###autoload
(defun magit-find-file (rev file)
"View FILE from REV.
Switch to a buffer visiting blob REV:FILE, creating one if none
already exists. If prior to calling this command the current
buffer and/or cursor position is about the same file, then go
to the line and column corresponding to that location."
(interactive (magit-find-file-read-args "Find file"))
(magit-find-file--internal rev file #'pop-to-buffer-same-window))
;;;###autoload
(defun magit-find-file-other-window (rev file)
"View FILE from REV, in another window.
Switch to a buffer visiting blob REV:FILE, creating one if none
already exists. If prior to calling this command the current
buffer and/or cursor position is about the same file, then go to
the line and column corresponding to that location."
(interactive (magit-find-file-read-args "Find file in other window"))
(magit-find-file--internal rev file #'switch-to-buffer-other-window))
;;;###autoload
(defun magit-find-file-other-frame (rev file)
"View FILE from REV, in another frame.
Switch to a buffer visiting blob REV:FILE, creating one if none
already exists. If prior to calling this command the current
buffer and/or cursor position is about the same file, then go to
the line and column corresponding to that location."
(interactive (magit-find-file-read-args "Find file in other frame"))
(magit-find-file--internal rev file #'switch-to-buffer-other-frame))
(defun magit-find-file-read-args (prompt)
(let ((pseudo-revs '("{worktree}" "{index}")))
(if-let ((rev (magit-completing-read "Find file from revision"
(append pseudo-revs
(magit-list-refnames nil t))
nil nil nil 'magit-revision-history
(or (magit-branch-or-commit-at-point)
(magit-get-current-branch)))))
(list rev (magit-read-file-from-rev (if (member rev pseudo-revs)
"HEAD"
rev)
prompt))
(user-error "Nothing selected"))))
(defun magit-find-file--internal (rev file fn)
(let ((buf (magit-find-file-noselect rev file))
line col)
(when-let ((visited-file (magit-file-relative-name)))
(setq line (line-number-at-pos))
(setq col (current-column))
(cond
((not (equal visited-file file)))
((equal magit-buffer-revision rev))
((equal rev "{worktree}")
(setq line (magit-diff-visit--offset file magit-buffer-revision line)))
((equal rev "{index}")
(setq line (magit-diff-visit--offset file nil line)))
(magit-buffer-revision
(setq line (magit-diff-visit--offset
file (concat magit-buffer-revision ".." rev) line)))
(t
(setq line (magit-diff-visit--offset file (list "-R" rev) line)))))
(funcall fn buf)
(when line
(with-current-buffer buf
(widen)
(goto-char (point-min))
(forward-line (1- line))
(move-to-column col)))
buf))
(defun magit-find-file-noselect (rev file)
"Read FILE from REV into a buffer and return the buffer.
REV is a revision or one of \"{worktree}\" or \"{index}\".
FILE must be relative to the top directory of the repository."
(magit-find-file-noselect-1 rev file))
(defun magit-find-file-noselect-1 (rev file &optional revert)
"Read FILE from REV into a buffer and return the buffer.
REV is a revision or one of \"{worktree}\" or \"{index}\".
FILE must be relative to the top directory of the repository.
Non-nil REVERT means to revert the buffer. If `ask-revert',
then only after asking. A non-nil value for REVERT is ignored if REV is
\"{worktree}\"."
(if (equal rev "{worktree}")
(find-file-noselect (expand-file-name file (magit-toplevel)))
(let ((topdir (magit-toplevel)))
(when (file-name-absolute-p file)
(setq file (file-relative-name file topdir)))
(with-current-buffer (magit-get-revision-buffer-create rev file)
(when (or (not magit-buffer-file-name)
(if (eq revert 'ask-revert)
(y-or-n-p (format "%s already exists; revert it? "
(buffer-name))))
revert)
(setq magit-buffer-revision
(if (equal rev "{index}")
"{index}"
(magit-rev-format "%H" rev)))
(setq magit-buffer-refname rev)
(setq magit-buffer-file-name (expand-file-name file topdir))
(setq default-directory
(let ((dir (file-name-directory magit-buffer-file-name)))
(if (file-exists-p dir) dir topdir)))
(setq-local revert-buffer-function #'magit-revert-rev-file-buffer)
(revert-buffer t t)
(run-hooks (if (equal rev "{index}")
'magit-find-index-hook
'magit-find-file-hook)))
(current-buffer)))))
(defun magit-get-revision-buffer-create (rev file)
(magit-get-revision-buffer rev file t))
(defun magit-get-revision-buffer (rev file &optional create)
(funcall (if create #'get-buffer-create #'get-buffer)
(format "%s.~%s~" file (subst-char-in-string ?/ ?_ rev))))
(defun magit-revert-rev-file-buffer (_ignore-auto noconfirm)
(when (or noconfirm
(and (not (buffer-modified-p))
(catch 'found
(dolist (regexp revert-without-query)
(when (string-match regexp magit-buffer-file-name)
(throw 'found t)))))
(yes-or-no-p (format "Revert buffer from Git %s? "
(if (equal magit-buffer-refname "{index}")
"index"
(concat "revision " magit-buffer-refname)))))
(let* ((inhibit-read-only t)
(default-directory (magit-toplevel))
(file (file-relative-name magit-buffer-file-name))
(coding-system-for-read (or coding-system-for-read 'undecided)))
(erase-buffer)
(magit-git-insert "cat-file" "-p"
(if (equal magit-buffer-refname "{index}")
(concat ":" file)
(concat magit-buffer-refname ":" file)))
(setq buffer-file-coding-system last-coding-system-used))
(let ((buffer-file-name magit-buffer-file-name)
(after-change-major-mode-hook
(remq 'global-diff-hl-mode-enable-in-buffers
after-change-major-mode-hook)))
(normal-mode t))
(setq buffer-read-only t)
(set-buffer-modified-p nil)
(goto-char (point-min))))
;;; Find Index
(defvar magit-find-index-hook nil)
(defun magit-find-file-index-noselect (file &optional revert)
"Read FILE from the index into a buffer and return the buffer.
FILE must to be relative to the top directory of the repository."
(magit-find-file-noselect-1 "{index}" file (or revert 'ask-revert)))
(defun magit-update-index ()
"Update the index with the contents of the current buffer.
The current buffer has to be visiting a file in the index, which
is done using `magit-find-index-noselect'."
(interactive)
(let ((file (magit-file-relative-name)))
(unless (equal magit-buffer-refname "{index}")
(user-error "%s isn't visiting the index" file))
(if (y-or-n-p (format "Update index with contents of %s" (buffer-name)))
(let ((index (make-temp-name (magit-git-dir "magit-update-index-")))
(buffer (current-buffer)))
(when magit-wip-before-change-mode
(magit-wip-commit-before-change (list file) " before un-/stage"))
(unwind-protect
(progn
(let ((coding-system-for-write buffer-file-coding-system))
(with-temp-file index
(insert-buffer-substring buffer)))
(magit-with-toplevel
(magit-call-git
"update-index" "--cacheinfo"
(substring (magit-git-string "ls-files" "-s" file)
0 6)
(magit-git-string "hash-object" "-t" "blob" "-w"
(concat "--path=" file)
"--" (magit-convert-filename-for-git index))
file)))
(ignore-errors (delete-file index)))
(set-buffer-modified-p nil)
(when magit-wip-after-apply-mode
(magit-wip-commit-after-apply (list file) " after un-/stage")))
(message "Abort")))
(--when-let (magit-get-mode-buffer 'magit-status-mode)
(with-current-buffer it (magit-refresh)))
t)
;;; Find Config File
(defun magit-find-git-config-file (filename &optional wildcards)
"Edit a file located in the current repository's git directory.
When \".git\", located at the root of the working tree, is a
regular file, then that makes it cumbersome to open a file
located in the actual git directory.
This command is like `find-file', except that it temporarily
binds `default-directory' to the actual git directory, while
reading the FILENAME."
(interactive
(let ((default-directory (magit-git-dir)))
(find-file-read-args "Find file: "
(confirm-nonexistent-file-or-buffer))))
(find-file filename wildcards))
(defun magit-find-git-config-file-other-window (filename &optional wildcards)
"Edit a file located in the current repo's git directory, in another window.
When \".git\", located at the root of the working tree, is a
regular file, then that makes it cumbersome to open a file
located in the actual git directory.
This command is like `find-file-other-window', except that it
temporarily binds `default-directory' to the actual git
directory, while reading the FILENAME."
(interactive
(let ((default-directory (magit-git-dir)))
(find-file-read-args "Find file in other window: "
(confirm-nonexistent-file-or-buffer))))
(find-file-other-window filename wildcards))
(defun magit-find-git-config-file-other-frame (filename &optional wildcards)
"Edit a file located in the current repo's git directory, in another frame.
When \".git\", located at the root of the working tree, is a
regular file, then that makes it cumbersome to open a file
located in the actual git directory.
This command is like `find-file-other-frame', except that it
temporarily binds `default-directory' to the actual git
directory, while reading the FILENAME."
(interactive
(let ((default-directory (magit-git-dir)))
(find-file-read-args "Find file in other frame: "
(confirm-nonexistent-file-or-buffer))))
(find-file-other-frame filename wildcards))
;;; File Dispatch
;;;###autoload (autoload 'magit-file-dispatch "magit" nil t)
(transient-define-prefix magit-file-dispatch ()
"Invoke a Magit command that acts on the visited file.
When invoked outside a file-visiting buffer, then fall back
to `magit-dispatch'."
:info-manual "(magit) Minor Mode for Buffers Visiting Files"
["Actions"
[("s" "Stage" magit-stage-file)
("u" "Unstage" magit-unstage-file)
("c" "Commit" magit-commit)
("e" "Edit line" magit-edit-line-commit)]
[("D" "Diff..." magit-diff)
("d" "Diff" magit-diff-buffer-file)
("g" "Status" magit-status-here)]
[("L" "Log..." magit-log)
("l" "Log" magit-log-buffer-file)
("t" "Trace" magit-log-trace-definition)
(7 "M" "Merged" magit-log-merged)]
[("B" "Blame..." magit-blame)
("b" "Blame" magit-blame-addition)
("r" "...removal" magit-blame-removal)
("f" "...reverse" magit-blame-reverse)
("m" "Blame echo" magit-blame-echo)
("q" "Quit blame" magit-blame-quit)]
[("p" "Prev blob" magit-blob-previous)
("n" "Next blob" magit-blob-next)
("v" "Goto blob" magit-find-file)
("V" "Goto file" magit-blob-visit-file)]
[(5 "C-c r" "Rename file" magit-file-rename)
(5 "C-c d" "Delete file" magit-file-delete)
(5 "C-c u" "Untrack file" magit-file-untrack)
(5 "C-c c" "Checkout file" magit-file-checkout)]]
(interactive)
(transient-setup
(if (magit-file-relative-name)
'magit-file-dispatch
'magit-dispatch)))
;;; Blob Mode
(defvar magit-blob-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "p" #'magit-blob-previous)
(define-key map "n" #'magit-blob-next)
(define-key map "b" #'magit-blame-addition)
(define-key map "r" #'magit-blame-removal)
(define-key map "f" #'magit-blame-reverse)
(define-key map "q" #'magit-kill-this-buffer)
map)
"Keymap for `magit-blob-mode'.")
(define-minor-mode magit-blob-mode
"Enable some Magit features in blob-visiting buffers.
Currently this only adds the following key bindings.
\n\\{magit-blob-mode-map}"
:package-version '(magit . "2.3.0"))
(defun magit-blob-next ()
"Visit the next blob which modified the current file."
(interactive)
(if magit-buffer-file-name
(magit-blob-visit (or (magit-blob-successor magit-buffer-revision
magit-buffer-file-name)
magit-buffer-file-name))
(if (buffer-file-name (buffer-base-buffer))
(user-error "You have reached the end of time")
(user-error "Buffer isn't visiting a file or blob"))))
(defun magit-blob-previous ()
"Visit the previous blob which modified the current file."
(interactive)
(if-let ((file (or magit-buffer-file-name
(buffer-file-name (buffer-base-buffer)))))
(--if-let (magit-blob-ancestor magit-buffer-revision file)
(magit-blob-visit it)
(user-error "You have reached the beginning of time"))
(user-error "Buffer isn't visiting a file or blob")))
;;;###autoload
(defun magit-blob-visit-file ()
"View the file from the worktree corresponding to the current blob.
When visiting a blob or the version from the index, then go to
the same location in the respective file in the working tree."
(interactive)
(if-let ((file (magit-file-relative-name)))
(magit-find-file--internal "{worktree}" file #'pop-to-buffer-same-window)
(user-error "Not visiting a blob")))
(defun magit-blob-visit (blob-or-file)
(if (stringp blob-or-file)
(find-file blob-or-file)
(pcase-let ((`(,rev ,file) blob-or-file))
(magit-find-file rev file)
(apply #'message "%s (%s %s ago)"
(magit-rev-format "%s" rev)
(magit--age (magit-rev-format "%ct" rev))))))
(defun magit-blob-ancestor (rev file)
(let ((lines (magit-with-toplevel
(magit-git-lines "log" "-2" "--format=%H" "--name-only"
"--follow" (or rev "HEAD") "--" file))))
(if rev (cddr lines) (butlast lines 2))))
(defun magit-blob-successor (rev file)
(let ((lines (magit-with-toplevel
(magit-git-lines "log" "--format=%H" "--name-only" "--follow"
"HEAD" "--" file))))
(catch 'found
(while lines
(if (equal (nth 2 lines) rev)
(throw 'found (list (nth 0 lines) (nth 1 lines)))
(setq lines (nthcdr 2 lines)))))))
;;; File Commands
(defun magit-file-rename (file newname)
"Rename or move FILE to NEWNAME.
NEWNAME may be a file or directory name. If FILE isn't tracked in
Git, fallback to using `rename-file'."
(interactive
(let* ((file (magit-read-file "Rename file"))
(dir (file-name-directory file))
(newname (read-file-name (format "Move %s to destination: " file)
(and dir (expand-file-name dir)))))
(list (expand-file-name file (magit-toplevel))
(expand-file-name newname))))
(let ((oldbuf (get-file-buffer file))
(dstdir (file-name-directory newname))
(dstfile (if (directory-name-p newname)
(concat newname (file-name-nondirectory file))
newname)))
(when (and oldbuf (buffer-modified-p oldbuf))
(user-error "Save %s before moving it" file))
(when (file-exists-p dstfile)
(user-error "%s already exists" dstfile))
(unless (file-exists-p dstdir)
(user-error "Destination directory %s does not exist" dstdir))
(if (magit-file-tracked-p (magit-convert-filename-for-git file))
(magit-call-git "mv"
(magit-convert-filename-for-git file)
(magit-convert-filename-for-git newname))
(rename-file file newname current-prefix-arg))
(when oldbuf
(with-current-buffer oldbuf
(let ((buffer-read-only buffer-read-only))
(set-visited-file-name dstfile nil t))
(if (fboundp 'vc-refresh-state)
(vc-refresh-state)
(with-no-warnings
(vc-find-file-hook))))))
(magit-refresh))
(defun magit-file-untrack (files &optional force)
"Untrack the selected FILES or one file read in the minibuffer.
With a prefix argument FORCE do so even when the files have
staged as well as unstaged changes."
(interactive (list (or (--if-let (magit-region-values 'file t)
(progn
(unless (magit-file-tracked-p (car it))
(user-error "Already untracked"))
(magit-confirm-files 'untrack it "Untrack"))
(list (magit-read-tracked-file "Untrack file"))))
current-prefix-arg))
(magit-with-toplevel
(magit-run-git "rm" "--cached" (and force "--force") "--" files)))
(defun magit-file-delete (files &optional force)
"Delete the selected FILES or one file read in the minibuffer.
With a prefix argument FORCE do so even when the files have
uncommitted changes. When the files aren't being tracked in
Git, then fallback to using `delete-file'."
(interactive (list (--if-let (magit-region-values 'file t)
(magit-confirm-files 'delete it "Delete")
(list (magit-read-file "Delete file")))
current-prefix-arg))
(if (magit-file-tracked-p (car files))
(magit-call-git "rm" (and force "--force") "--" files)
(let ((topdir (magit-toplevel)))
(dolist (file files)
(delete-file (expand-file-name file topdir) t))))
(magit-refresh))
;;;###autoload
(defun magit-file-checkout (rev file)
"Checkout FILE from REV."
(interactive
(let ((rev (magit-read-branch-or-commit
"Checkout from revision" magit-buffer-revision)))
(list rev (magit-read-file-from-rev rev "Checkout file"))))
(magit-with-toplevel
(magit-run-git "checkout" rev "--" file)))
;;; Read File
(defvar magit-read-file-hist nil)
(defun magit-read-file-from-rev (rev prompt &optional default)
(let ((files (magit-revision-files rev)))
(magit-completing-read
prompt files nil t nil 'magit-read-file-hist
(car (member (or default (magit-current-file)) files)))))
(defun magit-read-file (prompt &optional tracked-only)
(let ((choices (nconc (magit-list-files)
(unless tracked-only (magit-untracked-files)))))
(magit-completing-read
prompt choices nil t nil nil
(car (member (or (magit-section-value-if '(file submodule))
(magit-file-relative-name nil tracked-only))
choices)))))
(defun magit-read-tracked-file (prompt)
(magit-read-file prompt t))
(defun magit-read-unmerged-file (&optional prompt)
(let ((current (magit-current-file))
(unmerged (magit-unmerged-files)))
(unless unmerged
(user-error "There are no unresolved conflicts"))
(magit-completing-read (or prompt "Resolve file")
unmerged nil t nil nil
(car (member current unmerged)))))
(defun magit-read-file-choice (prompt files &optional error default)
"Read file from FILES.
If FILES has only one member, return that instead of prompting.
If FILES has no members, give a user error. ERROR can be given
to provide a more informative error.
If DEFAULT is non-nil, use this as the default value instead of
`magit-current-file'."
(pcase (length files)
(0 (user-error (or error "No file choices")))
(1 (car files))
(_ (magit-completing-read
prompt files nil t nil 'magit-read-file-hist
(car (member (or default (magit-current-file)) files))))))
(defun magit-read-changed-file (rev-or-range prompt &optional default)
(magit-read-file-choice
prompt
(magit-changed-files rev-or-range)
default
(concat "No file changed in " rev-or-range)))
;;; _
(provide 'magit-files)
;;; magit-files.el ends here

2633
code/elpa/magit-20220425.1153/magit-git.el Normal file
View file

File diff suppressed because it is too large Load diff

195
code/elpa/magit-20220425.1153/magit-gitignore.el Normal file
View file

@ -0,0 +1,195 @@
;;; magit-gitignore.el --- Intentionally untracked files -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library implements gitignore commands.
;;; Code:
(require 'magit)
;;; Transient
;;;###autoload (autoload 'magit-gitignore "magit-gitignore" nil t)
(transient-define-prefix magit-gitignore ()
"Instruct Git to ignore a file or pattern."
:man-page "gitignore"
["Gitignore"
("t" "shared at toplevel (.gitignore)"
magit-gitignore-in-topdir)
("s" "shared in subdirectory (path/to/.gitignore)"
magit-gitignore-in-subdir)
("p" "privately (.git/info/exclude)"
magit-gitignore-in-gitdir)
("g" magit-gitignore-on-system
:if (lambda () (magit-get "core.excludesfile"))
:description (lambda ()
(format "privately for all repositories (%s)"
(magit-get "core.excludesfile"))))]
["Skip worktree"
(7 "w" "do skip worktree" magit-skip-worktree)
(7 "W" "do not skip worktree" magit-no-skip-worktree)]
["Assume unchanged"
(7 "u" "do assume unchanged" magit-assume-unchanged)
(7 "U" "do not assume unchanged" magit-no-assume-unchanged)])
;;; Gitignore Commands
;;;###autoload
(defun magit-gitignore-in-topdir (rule)
"Add the Git ignore RULE to the top-level \".gitignore\" file.
Since this file is tracked, it is shared with other clones of the
repository. Also stage the file."
(interactive (list (magit-gitignore-read-pattern)))
(magit-with-toplevel
(magit--gitignore rule ".gitignore")
(magit-run-git "add" ".gitignore")))
;;;###autoload
(defun magit-gitignore-in-subdir (rule directory)
"Add the Git ignore RULE to a \".gitignore\" file in DIRECTORY.
Prompt the user for a directory and add the rule to the
\".gitignore\" file in that directory. Since such files are
tracked, they are shared with other clones of the repository.
Also stage the file."
(interactive (list (magit-gitignore-read-pattern)
(read-directory-name "Limit rule to files in: ")))
(magit-with-toplevel
(let ((file (expand-file-name ".gitignore" directory)))
(magit--gitignore rule file)
(magit-run-git "add" (magit-convert-filename-for-git file)))))
;;;###autoload
(defun magit-gitignore-in-gitdir (rule)
"Add the Git ignore RULE to \"$GIT_DIR/info/exclude\".
Rules in that file only affects this clone of the repository."
(interactive (list (magit-gitignore-read-pattern)))
(magit--gitignore rule (magit-git-dir "info/exclude"))
(magit-refresh))
;;;###autoload
(defun magit-gitignore-on-system (rule)
"Add the Git ignore RULE to the file specified by `core.excludesFile'.
Rules that are defined in that file affect all local repositories."
(interactive (list (magit-gitignore-read-pattern)))
(magit--gitignore rule
(or (magit-get "core.excludesFile")
(error "Variable `core.excludesFile' isn't set")))
(magit-refresh))
(defun magit--gitignore (rule file)
(when-let ((directory (file-name-directory file)))
(make-directory directory t))
(with-temp-buffer
(when (file-exists-p file)
(insert-file-contents file))
(goto-char (point-max))
(unless (bolp)
(insert "\n"))
(insert (replace-regexp-in-string "\\(\\\\*\\)" "\\1\\1" rule))
(insert "\n")
(write-region nil nil file)))
(defun magit-gitignore-read-pattern ()
(let* ((default (magit-current-file))
(base (car magit-buffer-diff-files))
(base (and base (file-directory-p base) base))
(choices
(delete-dups
(--mapcat
(cons (concat "/" it)
(and-let* ((ext (file-name-extension it)))
(list (concat "/" (file-name-directory it) "*." ext)
(concat "*." ext))))
(sort (nconc
(magit-untracked-files nil base)
;; The untracked section of the status buffer lists
;; directories containing only untracked files.
;; Add those as candidates.
(-filter #'directory-name-p
(magit-list-files
"--other" "--exclude-standard" "--directory"
"--no-empty-directory" "--" base)))
#'string-lessp)))))
(when default
(setq default (concat "/" default))
(unless (member default choices)
(setq default (concat "*." (file-name-extension default)))
(unless (member default choices)
(setq default nil))))
(magit-completing-read "File or pattern to ignore"
choices nil nil nil nil default)))
;;; Skip Worktree Commands
;;;###autoload
(defun magit-skip-worktree (file)
"Call \"git update-index --skip-worktree -- FILE\"."
(interactive
(list (magit-read-file-choice "Skip worktree for"
(magit-with-toplevel
(cl-set-difference
(magit-list-files)
(magit-skip-worktree-files)
:test #'equal)))))
(magit-with-toplevel
(magit-run-git "update-index" "--skip-worktree" "--" file)))
;;;###autoload
(defun magit-no-skip-worktree (file)
"Call \"git update-index --no-skip-worktree -- FILE\"."
(interactive
(list (magit-read-file-choice "Do not skip worktree for"
(magit-with-toplevel
(magit-skip-worktree-files)))))
(magit-with-toplevel
(magit-run-git "update-index" "--no-skip-worktree" "--" file)))
;;; Assume Unchanged Commands
;;;###autoload
(defun magit-assume-unchanged (file)
"Call \"git update-index --assume-unchanged -- FILE\"."
(interactive
(list (magit-read-file-choice "Assume file to be unchanged"
(magit-with-toplevel
(cl-set-difference
(magit-list-files)
(magit-assume-unchanged-files)
:test #'equal)))))
(magit-with-toplevel
(magit-run-git "update-index" "--assume-unchanged" "--" file)))
;;;###autoload
(defun magit-no-assume-unchanged (file)
"Call \"git update-index --no-assume-unchanged -- FILE\"."
(interactive
(list (magit-read-file-choice "Do not assume file to be unchanged"
(magit-with-toplevel
(magit-assume-unchanged-files)))))
(magit-with-toplevel
(magit-run-git "update-index" "--no-assume-unchanged" "--" file)))
;;; _
(provide 'magit-gitignore)
;;; magit-gitignore.el ends here

1938
code/elpa/magit-20220425.1153/magit-log.el Normal file
View file

File diff suppressed because it is too large Load diff

239
code/elpa/magit-20220425.1153/magit-margin.el Normal file
View file

@ -0,0 +1,239 @@
;;; magit-margin.el --- Margins in Magit buffers -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library implements support for showing additional information
;; in the margins of Magit buffers. Currently this is only used for
;; commits, for which the committer date or age, and optionally the
;; author name are shown.
;;; Code:
(require 'magit-base)
(require 'magit-transient)
(require 'magit-mode)
(defgroup magit-margin nil
"Information Magit displays in the margin.
You can change the STYLE and AUTHOR-WIDTH of all `magit-*-margin'
options to the same values by customizing `magit-log-margin'
*before* `magit' is loaded. If you do that, then the respective
values for the other options will default to what you have set
for that variable. Likewise if you set `magit-log-margin's INIT
to nil, then that is used in the default of all other options. But
setting it to t, i.e. re-enforcing the default for that option,
does not carry to other options."
:link '(info-link "(magit)Log Margin")
:group 'magit-log)
(defvar-local magit-buffer-margin nil)
(put 'magit-buffer-margin 'permanent-local t)
(defvar-local magit-set-buffer-margin-refresh nil)
(defvar magit--age-spec)
;;; Commands
(transient-define-prefix magit-margin-settings ()
"Change what information is displayed in the margin."
:info-manual "(magit) Log Margin"
["Margin"
("L" "Toggle visibility" magit-toggle-margin)
("l" "Cycle style" magit-cycle-margin-style)
("d" "Toggle details" magit-toggle-margin-details)
("v" "Change verbosity" magit-refs-set-show-commit-count
:if-derived magit-refs-mode)])
(defun magit-toggle-margin ()
"Show or hide the Magit margin."
(interactive)
(unless (magit-margin-option)
(user-error "Magit margin isn't supported in this buffer"))
(setcar magit-buffer-margin (not (magit-buffer-margin-p)))
(magit-set-buffer-margin))
(defvar magit-margin-default-time-format nil
"See https://github.com/magit/magit/pull/4605.")
(defun magit-cycle-margin-style ()
"Cycle style used for the Magit margin."
(interactive)
(unless (magit-margin-option)
(user-error "Magit margin isn't supported in this buffer"))
;; This is only suitable for commit margins (there are not others).
(setf (cadr magit-buffer-margin)
(pcase (cadr magit-buffer-margin)
('age 'age-abbreviated)
('age-abbreviated
(let ((default (or magit-margin-default-time-format
(cadr (symbol-value (magit-margin-option))))))
(if (stringp default) default "%Y-%m-%d %H:%M ")))
(_ 'age)))
(magit-set-buffer-margin nil t))
(defun magit-toggle-margin-details ()
"Show or hide details in the Magit margin."
(interactive)
(unless (magit-margin-option)
(user-error "Magit margin isn't supported in this buffer"))
(setf (nth 3 magit-buffer-margin)
(not (nth 3 magit-buffer-margin)))
(magit-set-buffer-margin nil t))
;;; Core
(defun magit-buffer-margin-p ()
(car magit-buffer-margin))
(defun magit-margin-option ()
(pcase major-mode
('magit-cherry-mode 'magit-cherry-margin)
('magit-log-mode 'magit-log-margin)
('magit-log-select-mode 'magit-log-select-margin)
('magit-reflog-mode 'magit-reflog-margin)
('magit-refs-mode 'magit-refs-margin)
('magit-stashes-mode 'magit-stashes-margin)
('magit-status-mode 'magit-status-margin)
('forge-notifications-mode 'magit-status-margin)))
(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)))
(with-selected-window window
(set-window-margins
nil (car (window-margins))
(and (magit-buffer-margin-p)
(nth 2 magit-buffer-margin))))))
(defun magit-make-margin-overlay (&optional string previous-line)
(if previous-line
(save-excursion
(forward-line -1)
(magit-make-margin-overlay string))
;; Don't put the overlay on the complete line to work around #1880.
(let ((o (make-overlay (1+ (line-beginning-position))
(line-end-position)
nil t)))
(overlay-put o 'evaporate t)
(overlay-put o 'before-string
(propertize "o" 'display
(list (list 'margin 'right-margin)
(or string " ")))))))
(defun magit-maybe-make-margin-overlay ()
(when (or (magit-section-match
'(unpulled unpushed recent stashes local cherries)
magit-insert-section--current)
(and (eq major-mode 'magit-refs-mode)
(magit-section-match
'(remote commit tags)
magit-insert-section--current)))
(magit-make-margin-overlay nil t)))
;;; Custom Support
(defun magit-margin-set-variable (mode symbol value)
(set-default symbol value)
(message "Updating margins in %s buffers..." mode)
(dolist (buffer (buffer-list))
(with-current-buffer buffer
(when (eq major-mode mode)
(magit-set-buffer-margin t)
(magit-refresh))))
(message "Updating margins in %s buffers...done" mode))
(defconst magit-log-margin--custom-type
'(list (boolean :tag "Show margin initially")
(choice :tag "Show committer"
(string :tag "date using time-format" "%Y-%m-%d %H:%M ")
(const :tag "date's age" age)
(const :tag "date's age (abbreviated)" age-abbreviated))
(const :tag "Calculate width using magit-log-margin-width"
magit-log-margin-width)
(boolean :tag "Show author name by default")
(integer :tag "Show author name using width")))
;;; Time Utilities
(defvar magit--age-spec
`((?Y "year" "years" ,(round (* 60 60 24 365.2425)))
(?M "month" "months" ,(round (* 60 60 24 30.436875)))
(?w "week" "weeks" ,(* 60 60 24 7))
(?d "day" "days" ,(* 60 60 24))
(?h "hour" "hours" ,(* 60 60))
(?m "minute" "minutes" 60)
(?s "second" "seconds" 1))
"Time units used when formatting relative commit ages.
The value is a list of time units, beginning with the longest.
Each element has the form (CHAR UNIT UNITS SECONDS). UNIT is the
time unit, UNITS is the plural of that unit. CHAR is a character
abbreviation. And SECONDS is the number of seconds in one UNIT.
This is defined as a variable to make it possible to use time
units for a language other than English. It is not defined
as an option, because most other parts of Magit are always in
English.")
(defun magit--age (date &optional abbreviate)
(cl-labels ((fn (age spec)
(pcase-let ((`(,char ,unit ,units ,weight) (car spec)))
(let ((cnt (round (/ age weight 1.0))))
(if (or (not (cdr spec))
(>= (/ age weight) 1))
(list cnt (cond (abbreviate char)
((= cnt 1) unit)
(t units)))
(fn age (cdr spec)))))))
(fn (abs (- (float-time)
(if (stringp date)
(string-to-number date)
date)))
magit--age-spec)))
;;; _
(provide 'magit-margin)
;;; magit-margin.el ends here

318
code/elpa/magit-20220425.1153/magit-merge.el Normal file
View file

@ -0,0 +1,318 @@
;;; magit-merge.el --- Merge functionality -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library implements merge commands.
;;; Code:
(require 'magit)
(require 'magit-diff)
(declare-function magit-git-push "magit-push" (branch target args))
;;; Commands
;;;###autoload (autoload 'magit-merge "magit" nil t)
(transient-define-prefix magit-merge ()
"Merge branches."
:man-page "git-merge"
:incompatible '(("--ff-only" "--no-ff"))
["Arguments"
:if-not magit-merge-in-progress-p
("-f" "Fast-forward only" "--ff-only")
("-n" "No fast-forward" "--no-ff")
(magit-merge:--strategy)
(5 magit-merge:--strategy-option)
(5 "-b" "Ignore changes in amount of whitespace" "-Xignore-space-change")
(5 "-w" "Ignore whitespace when comparing lines" "-Xignore-all-space")
(5 magit-diff:--diff-algorithm :argument "-Xdiff-algorithm=")
(5 magit:--gpg-sign)]
["Actions"
:if-not magit-merge-in-progress-p
[("m" "Merge" magit-merge-plain)
("e" "Merge and edit message" magit-merge-editmsg)
("n" "Merge but don't commit" magit-merge-nocommit)
("a" "Absorb" magit-merge-absorb)]
[("p" "Preview merge" magit-merge-preview)
""
("s" "Squash merge" magit-merge-squash)
("i" "Dissolve" magit-merge-into)]]
["Actions"
:if magit-merge-in-progress-p
("m" "Commit merge" magit-commit-create)
("a" "Abort merge" magit-merge-abort)])
(defun magit-merge-arguments ()
(transient-args 'magit-merge))
(transient-define-argument magit-merge:--strategy ()
:description "Strategy"
:class 'transient-option
;; key for merge and rebase: "-s"
;; key for cherry-pick and revert: "=s"
;; shortarg for merge and rebase: "-s"
;; shortarg for cherry-pick and revert: none
:key "-s"
:argument "--strategy="
:choices '("resolve" "recursive" "octopus" "ours" "subtree"))
(transient-define-argument magit-merge:--strategy-option ()
:description "Strategy Option"
:class 'transient-option
:key "-X"
:argument "--strategy-option="
:choices '("ours" "theirs" "patience"))
;;;###autoload
(defun magit-merge-plain (rev &optional args nocommit)
"Merge commit REV into the current branch; using default message.
Unless there are conflicts or a prefix argument is used create a
merge commit using a generic commit message and without letting
the user inspect the result. With a prefix argument pretend the
merge failed to give the user the opportunity to inspect the
merge.
\(git merge --no-edit|--no-commit [ARGS] REV)"
(interactive (list (magit-read-other-branch-or-commit "Merge")
(magit-merge-arguments)
current-prefix-arg))
(magit-merge-assert)
(magit-run-git-async "merge" (if nocommit "--no-commit" "--no-edit") args rev))
;;;###autoload
(defun magit-merge-editmsg (rev &optional args)
"Merge commit REV into the current branch; and edit message.
Perform the merge and prepare a commit message but let the user
edit it.
\n(git merge --edit --no-ff [ARGS] REV)"
(interactive (list (magit-read-other-branch-or-commit "Merge")
(magit-merge-arguments)))
(magit-merge-assert)
(cl-pushnew "--no-ff" args :test #'equal)
(apply #'magit-run-git-with-editor "merge" "--edit"
(append (delete "--ff-only" args)
(list rev))))
;;;###autoload
(defun magit-merge-nocommit (rev &optional args)
"Merge commit REV into the current branch; pretending it failed.
Pretend the merge failed to give the user the opportunity to
inspect the merge and change the commit message.
\n(git merge --no-commit --no-ff [ARGS] REV)"
(interactive (list (magit-read-other-branch-or-commit "Merge")
(magit-merge-arguments)))
(magit-merge-assert)
(cl-pushnew "--no-ff" args :test #'equal)
(magit-run-git-async "merge" "--no-commit" args rev))
;;;###autoload
(defun magit-merge-into (branch &optional args)
"Merge the current branch into BRANCH and remove the former.
Before merging, force push the source branch to its push-remote,
provided the respective remote branch already exists, ensuring
that the respective pull-request (if any) won't get stuck on some
obsolete version of the commits that are being merged. Finally
if `forge-branch-pullreq' was used to create the merged branch,
then also remove the respective remote branch."
(interactive
(list (magit-read-other-local-branch
(format "Merge `%s' into"
(or (magit-get-current-branch)
(magit-rev-parse "HEAD")))
nil
(and-let* ((upstream (magit-get-upstream-branch))
(upstream (cdr (magit-split-branch-name upstream))))
(and (magit-branch-p upstream) upstream)))
(magit-merge-arguments)))
(let ((current (magit-get-current-branch))
(head (magit-rev-parse "HEAD")))
(when (zerop (magit-call-git "checkout" branch))
(if current
(magit--merge-absorb current args)
(magit-run-git-with-editor "merge" args head)))))
;;;###autoload
(defun magit-merge-absorb (branch &optional args)
"Merge BRANCH into the current branch and remove the former.
Before merging, force push the source branch to its push-remote,
provided the respective remote branch already exists, ensuring
that the respective pull-request (if any) won't get stuck on some
obsolete version of the commits that are being merged. Finally
if `forge-branch-pullreq' was used to create the merged branch,
then also remove the respective remote branch."
(interactive (list (magit-read-other-local-branch "Absorb branch")
(magit-merge-arguments)))
(magit--merge-absorb branch args))
(defun magit--merge-absorb (branch args)
(when (equal branch (magit-main-branch))
(unless (yes-or-no-p
(format "Do you really want to merge `%s' into another branch? "
branch))
(user-error "Abort")))
(if-let ((target (magit-get-push-branch branch t)))
(progn
(magit-git-push branch target (list "--force-with-lease"))
(set-process-sentinel
magit-this-process
(lambda (process event)
(when (memq (process-status process) '(exit signal))
(if (not (zerop (process-exit-status process)))
(magit-process-sentinel process event)
(process-put process 'inhibit-refresh t)
(magit-process-sentinel process event)
(magit--merge-absorb-1 branch args))))))
(magit--merge-absorb-1 branch args)))
(defun magit--merge-absorb-1 (branch args)
(if-let ((pr (magit-get "branch" branch "pullRequest")))
(magit-run-git-async
"merge" args "-m"
(format "Merge branch '%s'%s [#%s]"
branch
(let ((current (magit-get-current-branch)))
(if (equal current (magit-main-branch))
""
(format " into %s" current)))
pr)
branch)
(magit-run-git-async "merge" args "--no-edit" branch))
(set-process-sentinel
magit-this-process
(lambda (process event)
(when (memq (process-status process) '(exit signal))
(if (> (process-exit-status process) 0)
(magit-process-sentinel process event)
(process-put process 'inhibit-refresh t)
(magit-process-sentinel process event)
(magit-branch-maybe-delete-pr-remote branch)
(magit-branch-unset-pushRemote branch)
(magit-run-git "branch" "-D" branch))))))
;;;###autoload
(defun magit-merge-squash (rev)
"Squash commit REV into the current branch; don't create a commit.
\n(git merge --squash REV)"
(interactive (list (magit-read-other-branch-or-commit "Squash")))
(magit-merge-assert)
(magit-run-git-async "merge" "--squash" rev))
;;;###autoload
(defun magit-merge-preview (rev)
"Preview result of merging REV into the current branch."
(interactive (list (magit-read-other-branch-or-commit "Preview merge")))
(magit-merge-preview-setup-buffer rev))
;;;###autoload
(defun magit-merge-abort ()
"Abort the current merge operation.
\n(git merge --abort)"
(interactive)
(unless (file-exists-p (magit-git-dir "MERGE_HEAD"))
(user-error "No merge in progress"))
(magit-confirm 'abort-merge)
(magit-run-git-async "merge" "--abort"))
(defun magit-checkout-stage (file arg)
"During a conflict checkout and stage side, or restore conflict."
(interactive
(let ((file (magit-completing-read "Checkout file"
(magit-tracked-files) nil nil nil
'magit-read-file-hist
(magit-current-file))))
(cond ((member file (magit-unmerged-files))
(list file (magit-checkout-read-stage file)))
((yes-or-no-p (format "Restore conflicts in %s? " file))
(list file "--merge"))
(t
(user-error "Quit")))))
(pcase (cons arg (cddr (car (magit-file-status file))))
((or `("--ours" ?D ,_)
'("--ours" ?U ?A)
`("--theirs" ,_ ?D)
'("--theirs" ?A ?U))
(magit-run-git "rm" "--" file))
(_ (if (equal arg "--merge")
;; This fails if the file was deleted on one
;; side. And we cannot do anything about it.
(magit-run-git "checkout" "--merge" "--" file)
(magit-call-git "checkout" arg "--" file)
(magit-run-git "add" "-u" "--" file)))))
;;; Utilities
(defun magit-merge-in-progress-p ()
(file-exists-p (magit-git-dir "MERGE_HEAD")))
(defun magit--merge-range (&optional head)
(unless head
(setq head (magit-get-shortname
(car (magit-file-lines (magit-git-dir "MERGE_HEAD"))))))
(and head
(concat (magit-git-string "merge-base" "--octopus" "HEAD" head)
".." head)))
(defun magit-merge-assert ()
(or (not (magit-anything-modified-p t))
(magit-confirm 'merge-dirty
"Merging with dirty worktree is risky. Continue")))
(defun magit-checkout-read-stage (file)
(magit-read-char-case (format "For %s checkout: " file) t
(?o "[o]ur stage" "--ours")
(?t "[t]heir stage" "--theirs")
(?c "[c]onflict" "--merge")))
;;; Sections
(defvar magit-unmerged-section-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map magit-log-section-map)
map)
"Keymap for `unmerged' sections.")
(defun magit-insert-merge-log ()
"Insert section for the on-going merge.
Display the heads that are being merged.
If no merge is in progress, do nothing."
(when (magit-merge-in-progress-p)
(let* ((heads (mapcar #'magit-get-shortname
(magit-file-lines (magit-git-dir "MERGE_HEAD"))))
(range (magit--merge-range (car heads))))
(magit-insert-section (unmerged range)
(magit-insert-heading
(format "Merging %s:" (mapconcat #'identity heads ", ")))
(magit-insert-log
range
(let ((args magit-buffer-log-args))
(unless (member "--decorate=full" magit-buffer-log-args)
(push "--decorate=full" args))
args))))))
;;; _
(provide 'magit-merge)
;;; magit-merge.el ends here

1547
code/elpa/magit-20220425.1153/magit-mode.el Normal file
View file

File diff suppressed because it is too large Load diff

201
code/elpa/magit-20220425.1153/magit-notes.el Normal file
View file

@ -0,0 +1,201 @@
;;; magit-notes.el --- Notes support -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library implements support for `git-notes'.
;;; Code:
(require 'magit)
;;; Commands
;;;###autoload (autoload 'magit-notes "magit" nil t)
(transient-define-prefix magit-notes ()
"Edit notes attached to commits."
:man-page "git-notes"
["Configure local settings"
("c" magit-core.notesRef)
("d" magit-notes.displayRef)]
["Configure global settings"
("C" magit-global-core.notesRef)
("D" magit-global-notes.displayRef)]
["Arguments for prune"
:if-not magit-notes-merging-p
("-n" "Dry run" ("-n" "--dry-run"))]
["Arguments for edit and remove"
:if-not magit-notes-merging-p
(magit-notes:--ref)]
["Arguments for merge"
:if-not magit-notes-merging-p
(magit-notes:--strategy)]
["Actions"
:if-not magit-notes-merging-p
("T" "Edit" magit-notes-edit)
("r" "Remove" magit-notes-remove)
("m" "Merge" magit-notes-merge)
("p" "Prune" magit-notes-prune)]
["Actions"
:if magit-notes-merging-p
("c" "Commit merge" magit-notes-merge-commit)
("a" "Abort merge" magit-notes-merge-abort)])
(defun magit-notes-merging-p ()
(let ((dir (magit-git-dir "NOTES_MERGE_WORKTREE")))
(and (file-directory-p dir)
(directory-files dir nil "^[^.]"))))
(transient-define-infix magit-core.notesRef ()
:class 'magit--git-variable
:variable "core.notesRef"
:reader #'magit-notes-read-ref
:prompt "Set local core.notesRef")
(transient-define-infix magit-notes.displayRef ()
:class 'magit--git-variable
:variable "notes.displayRef"
:multi-value t
:reader #'magit-notes-read-refs
:prompt "Set local notes.displayRef")
(transient-define-infix magit-global-core.notesRef ()
:class 'magit--git-variable
:variable "core.notesRef"
:global t
:reader #'magit-notes-read-ref
:prompt "Set global core.notesRef")
(transient-define-infix magit-global-notes.displayRef ()
:class 'magit--git-variable
:variable "notes.displayRef"
:global t
:multi-value t
:reader #'magit-notes-read-refs
:prompt "Set global notes.displayRef")
(transient-define-argument magit-notes:--ref ()
:description "Manipulate ref"
:class 'transient-option
:key "-r"
:argument "--ref="
:reader #'magit-notes-read-ref)
(transient-define-argument magit-notes:--strategy ()
:description "Merge strategy"
:class 'transient-option
:shortarg "-s"
:argument "--strategy="
:choices '("manual" "ours" "theirs" "union" "cat_sort_uniq"))
(defun magit-notes-edit (commit &optional ref)
"Edit the note attached to COMMIT.
REF is the notes ref used to store the notes.
Interactively or when optional REF is nil use the value of Git
variable `core.notesRef' or \"refs/notes/commits\" if that is
undefined."
(interactive (magit-notes-read-args "Edit notes"))
(magit-run-git-with-editor "notes" (and ref (concat "--ref=" ref))
"edit" commit))
(defun magit-notes-remove (commit &optional ref)
"Remove the note attached to COMMIT.
REF is the notes ref from which the note is removed.
Interactively or when optional REF is nil use the value of Git
variable `core.notesRef' or \"refs/notes/commits\" if that is
undefined."
(interactive (magit-notes-read-args "Remove notes"))
(magit-run-git-with-editor "notes" (and ref (concat "--ref=" ref))
"remove" commit))
(defun magit-notes-merge (ref)
"Merge the notes ref REF into the current notes ref.
The current notes ref is the value of Git variable
`core.notesRef' or \"refs/notes/commits\" if that is undefined.
When there are conflicts, then they have to be resolved in the
temporary worktree \".git/NOTES_MERGE_WORKTREE\". When
done use `magit-notes-merge-commit' to finish. To abort
use `magit-notes-merge-abort'."
(interactive (list (magit-read-string-ns "Merge reference")))
(magit-run-git-with-editor "notes" "merge" ref))
(defun magit-notes-merge-commit ()
"Commit the current notes ref merge.
Also see `magit-notes-merge'."
(interactive)
(magit-run-git-with-editor "notes" "merge" "--commit"))
(defun magit-notes-merge-abort ()
"Abort the current notes ref merge.
Also see `magit-notes-merge'."
(interactive)
(magit-run-git-with-editor "notes" "merge" "--abort"))
(defun magit-notes-prune (&optional dry-run)
"Remove notes about unreachable commits."
(interactive (list (and (member "--dry-run" (transient-args 'magit-notes)) t)))
(when dry-run
(magit-process-buffer))
(magit-run-git-with-editor "notes" "prune" (and dry-run "--dry-run")))
;;; Readers
(defun magit-notes-read-ref (prompt _initial-input history)
(and-let* ((ref (magit-completing-read
prompt (magit-list-notes-refnames) nil nil
(and-let* ((def (magit-get "core.notesRef")))
(if (string-prefix-p "refs/notes/" def)
(substring def 11)
def))
history)))
(if (string-prefix-p "refs/" ref)
ref
(concat "refs/notes/" ref))))
(defun magit-notes-read-refs (prompt &optional _initial-input _history)
(mapcar (lambda (ref)
(if (string-prefix-p "refs/" ref)
ref
(concat "refs/notes/" ref)))
(completing-read-multiple
(concat prompt ": ")
(magit-list-notes-refnames) nil nil
(mapconcat (lambda (ref)
(if (string-prefix-p "refs/notes/" ref)
(substring ref 11)
ref))
(magit-get-all "notes.displayRef")
","))))
(defun magit-notes-read-args (prompt)
(list (magit-read-branch-or-commit prompt (magit-stash-at-point))
(and-let* ((str (--first (string-match "^--ref=\\(.+\\)" it)
(transient-args 'magit-notes))))
(match-string 1 str))))
;;; _
(provide 'magit-notes)
;;; magit-notes.el ends here

111
code/elpa/magit-20220425.1153/magit-obsolete.el Normal file
View file

@ -0,0 +1,111 @@
;;; magit-obsolete.el --- Obsolete definitions -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library defines aliases for obsolete variables and functions.
;;; Code:
(require 'magit)
;;; Obsolete since v3.0.0
(define-obsolete-function-alias 'magit-diff-visit-file-worktree
#'magit-diff-visit-worktree-file "Magit 3.0.0")
(define-obsolete-function-alias 'magit-status-internal
#'magit-status-setup-buffer "Magit 3.0.0")
(define-obsolete-variable-alias 'magit-mode-setup-hook
'magit-setup-buffer-hook "Magit 3.0.0")
(define-obsolete-variable-alias 'magit-branch-popup-show-variables
'magit-branch-direct-configure "Magit 3.0.0")
(define-obsolete-function-alias 'magit-dispatch-popup
#'magit-dispatch "Magit 3.0.0")
(define-obsolete-function-alias 'magit-repolist-column-dirty
#'magit-repolist-column-flag "Magit 3.0.0")
(define-obsolete-variable-alias 'magit-disable-line-numbers
'magit-section-disable-line-numbers "Magit 3.0.0")
(define-obsolete-variable-alias 'inhibit-magit-refresh
'magit-inhibit-refresh "Magit 3.0.0")
(defun magit--magit-popup-warning ()
(display-warning 'magit "\
Magit no longer uses Magit-Popup.
It now uses Transient.
See https://emacsair.me/2019/02/14/transient-0.1.
However your configuration and/or some third-party package that
you use still depends on the `magit-popup' package. But because
`magit' no longer depends on that, `package' has removed it from
your system.
If some package that you use still depends on `magit-popup' but
does not declare it as a dependency, then please contact its
maintainer about that and install `magit-popup' explicitly.
If you yourself use functions that are defined in `magit-popup'
in your configuration, then the next step depends on what you use
that for.
* If you use `magit-popup' to define your own popups but do not
modify any of Magit's old popups, then you have to install
`magit-popup' explicitly. (You can also migrate to Transient,
but there is no need to rush that.)
* If you add additional arguments and/or actions to Magit's popups,
then you have to port that to modify the new \"transients\" instead.
See https://github.com/magit/magit/wiki/\
Converting-popup-modifications-to-transient-modifications
To find installed packages that still use `magit-popup' you can
use e.g. \"M-x rgrep RET magit-popup RET RET ~/.emacs.d/ RET\"."))
(cl-eval-when (eval load)
(unless (require (quote magit-popup) nil t)
(defun magit-define-popup-switch (&rest _)
(magit--magit-popup-warning))
(defun magit-define-popup-option (&rest _)
(magit--magit-popup-warning))
(defun magit-define-popup-variable (&rest _)
(magit--magit-popup-warning))
(defun magit-define-popup-action (&rest _)
(magit--magit-popup-warning))
(defun magit-define-popup-sequence-action (&rest _)
(magit--magit-popup-warning))
(defun magit-define-popup-key (&rest _)
(magit--magit-popup-warning))
(defun magit-define-popup-keys-deferred (&rest _)
(magit--magit-popup-warning))
(defun magit-change-popup-key (&rest _)
(magit--magit-popup-warning))
(defun magit-remove-popup-key (&rest _)
(magit--magit-popup-warning))))
;;; _
(provide 'magit-obsolete)
;;; magit-obsolete.el ends here

326
code/elpa/magit-20220425.1153/magit-patch.el Normal file
View file

@ -0,0 +1,326 @@
;;; magit-patch.el --- Creating and applying patches -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library implements patch commands.
;;; Code:
(require 'magit)
;;; Options
(defcustom magit-patch-save-arguments '(exclude "--stat")
"Control arguments used by the command `magit-patch-save'.
`magit-patch-save' (which see) saves a diff for the changes
shown in the current buffer in a patch file. It may use the
same arguments as used in the buffer or a subset thereof, or
a constant list of arguments, depending on this option and
the prefix argument."
:package-version '(magit . "2.12.0")
:group 'magit-diff
:type '(choice (const :tag "use buffer arguments" buffer)
(cons :tag "use buffer arguments except"
(const :format "" exclude)
(repeat :format "%v%i\n"
(string :tag "Argument")))
(repeat :tag "use constant arguments"
(string :tag "Argument"))))
;;; Commands
;;;###autoload (autoload 'magit-patch "magit-patch" nil t)
(transient-define-prefix magit-patch ()
"Create or apply patches."
["Actions"
[("c" "Create patches" magit-patch-create)
("w" "Apply patches" magit-am)]
[("a" "Apply plain patch" magit-patch-apply)
("s" "Save diff as patch" magit-patch-save)]
[("r" "Request pull" magit-request-pull)]])
;;;###autoload (autoload 'magit-patch-create "magit-patch" nil t)
(transient-define-prefix magit-patch-create (range args files)
"Create patches for the commits in RANGE.
When a single commit is given for RANGE, create a patch for the
changes introduced by that commit (unlike 'git format-patch'
which creates patches for all commits that are reachable from
`HEAD' but not from the specified commit)."
:man-page "git-format-patch"
:incompatible '(("--subject-prefix=" "--rfc"))
["Mail arguments"
(6 magit-format-patch:--in-reply-to)
(6 magit-format-patch:--thread)
(6 magit-format-patch:--from)
(6 magit-format-patch:--to)
(6 magit-format-patch:--cc)]
["Patch arguments"
(magit-format-patch:--base)
(magit-format-patch:--reroll-count)
(5 magit-format-patch:--interdiff)
(magit-format-patch:--range-diff)
(magit-format-patch:--subject-prefix)
("C-m r " "RFC subject prefix" "--rfc")
("C-m l " "Add cover letter" "--cover-letter")
(5 magit-format-patch:--cover-from-description)
(5 magit-format-patch:--notes)
(magit-format-patch:--output-directory)]
["Diff arguments"
(magit-diff:-U)
(magit-diff:-M)
(magit-diff:-C)
(magit-diff:--diff-algorithm)
(magit:--)
(7 "-b" "Ignore whitespace changes" ("-b" "--ignore-space-change"))
(7 "-w" "Ignore all whitespace" ("-w" "--ignore-all-space"))]
["Actions"
("c" "Create patches" magit-patch-create)]
(interactive
(if (not (eq transient-current-command 'magit-patch-create))
(list nil nil nil)
(cons (if-let ((revs (magit-region-values 'commit t)))
(concat (car (last revs)) "^.." (car revs))
(let ((range (magit-read-range-or-commit
"Format range or commit")))
(if (string-search ".." range)
range
(format "%s~..%s" range range))))
(let ((args (transient-args 'magit-patch-create)))
(list (-filter #'stringp args)
(cdr (assoc "--" args)))))))
(if (not range)
(transient-setup 'magit-patch-create)
(magit-run-git "format-patch" range args "--" files)
(when (member "--cover-letter" args)
(save-match-data
(find-file
(expand-file-name
(concat (and-let* ((v (transient-arg-value "--reroll-count=" args)))
(format "v%s-" v))
"0000-cover-letter.patch")
(let ((topdir (magit-toplevel)))
(if-let ((dir (transient-arg-value "--output-directory=" args)))
(expand-file-name dir topdir)
topdir))))))))
(transient-define-argument magit-format-patch:--in-reply-to ()
:description "In reply to"
:class 'transient-option
:key "C-m C-r"
:argument "--in-reply-to=")
(transient-define-argument magit-format-patch:--thread ()
:description "Thread style"
:class 'transient-option
:key "C-m s "
:argument "--thread="
:reader #'magit-format-patch-select-thread-style)
(defun magit-format-patch-select-thread-style (&rest _ignore)
(magit-read-char-case "Thread style " t
(?d "[d]eep" "deep")
(?s "[s]hallow" "shallow")))
(transient-define-argument magit-format-patch:--base ()
:description "Insert base commit"
:class 'transient-option
:key "C-m b "
:argument "--base="
:reader #'magit-format-patch-select-base)
(defun magit-format-patch-select-base (prompt initial-input history)
(or (magit-completing-read prompt (cons "auto" (magit-list-refnames))
nil nil initial-input history "auto")
(user-error "Nothing selected")))
(transient-define-argument magit-format-patch:--reroll-count ()
:description "Reroll count"
:class 'transient-option
:key "C-m v "
:shortarg "-v"
:argument "--reroll-count="
:reader #'transient-read-number-N+)
(transient-define-argument magit-format-patch:--interdiff ()
:description "Insert interdiff"
:class 'transient-option
:key "C-m d i"
:argument "--interdiff="
:reader #'magit-transient-read-revision)
(transient-define-argument magit-format-patch:--range-diff ()
:description "Insert range-diff"
:class 'transient-option
:key "C-m d r"
:argument "--range-diff="
:reader #'magit-format-patch-select-range-diff)
(defun magit-format-patch-select-range-diff (prompt _initial-input _history)
(magit-read-range-or-commit prompt))
(transient-define-argument magit-format-patch:--subject-prefix ()
:description "Subject Prefix"
:class 'transient-option
:key "C-m p "
:argument "--subject-prefix=")
(transient-define-argument magit-format-patch:--cover-from-description ()
:description "Use branch description"
:class 'transient-option
:key "C-m D "
:argument "--cover-from-description="
:reader #'magit-format-patch-select-description-mode)
(defun magit-format-patch-select-description-mode (&rest _ignore)
(magit-read-char-case "Use description as " t
(?m "[m]essage" "message")
(?s "[s]ubject" "subject")
(?a "[a]uto" "auto")
(?n "[n]othing" "none")))
(transient-define-argument magit-format-patch:--notes ()
:description "Insert commentary from notes"
:class 'transient-option
:key "C-m n "
:argument "--notes="
:reader #'magit-notes-read-ref)
(transient-define-argument magit-format-patch:--from ()
:description "From"
:class 'transient-option
:key "C-m C-f"
:argument "--from="
:reader #'magit-transient-read-person)
(transient-define-argument magit-format-patch:--to ()
:description "To"
:class 'transient-option
:key "C-m C-t"
:argument "--to="
:reader #'magit-transient-read-person)
(transient-define-argument magit-format-patch:--cc ()
:description "CC"
:class 'transient-option
:key "C-m C-c"
:argument "--cc="
:reader #'magit-transient-read-person)
(transient-define-argument magit-format-patch:--output-directory ()
:description "Output directory"
:class 'transient-option
:key "C-m o "
:shortarg "-o"
:argument "--output-directory="
:reader #'transient-read-existing-directory)
;;;###autoload (autoload 'magit-patch-apply "magit-patch" nil t)
(transient-define-prefix magit-patch-apply (file &rest args)
"Apply the patch file FILE."
:man-page "git-apply"
["Arguments"
("-i" "Also apply to index" "--index")
("-c" "Only apply to index" "--cached")
("-3" "Fall back on 3way merge" ("-3" "--3way"))]
["Actions"
("a" "Apply patch" magit-patch-apply)]
(interactive
(if (not (eq transient-current-command 'magit-patch-apply))
(list nil)
(list (expand-file-name
(read-file-name "Apply patch: "
default-directory nil nil
(and-let* ((file (magit-file-at-point)))
(file-relative-name file))))
(transient-args 'magit-patch-apply))))
(if (not file)
(transient-setup 'magit-patch-apply)
(magit-run-git "apply" args "--" (magit-convert-filename-for-git file))))
;;;###autoload
(defun magit-patch-save (file &optional arg)
"Write current diff into patch FILE.
What arguments are used to create the patch depends on the value
of `magit-patch-save-arguments' and whether a prefix argument is
used.
If the value is the symbol `buffer', then use the same arguments
as the buffer. With a prefix argument use no arguments.
If the value is a list beginning with the symbol `exclude', then
use the same arguments as the buffer except for those matched by
entries in the cdr of the list. The comparison is done using
`string-prefix-p'. With a prefix argument use the same arguments
as the buffer.
If the value is a list of strings (including the empty list),
then use those arguments. With a prefix argument use the same
arguments as the buffer.
Of course the arguments that are required to actually show the
same differences as those shown in the buffer are always used."
(interactive (list (read-file-name "Write patch file: " default-directory)
current-prefix-arg))
(unless (derived-mode-p 'magit-diff-mode)
(user-error "Only diff buffers can be saved as patches"))
(let ((rev magit-buffer-range)
(typearg magit-buffer-typearg)
(args magit-buffer-diff-args)
(files magit-buffer-diff-files))
(cond ((eq magit-patch-save-arguments 'buffer)
(when arg
(setq args nil)))
((eq (car-safe magit-patch-save-arguments) 'exclude)
(unless arg
(setq args (-difference args (cdr magit-patch-save-arguments)))))
((not arg)
(setq args magit-patch-save-arguments)))
(with-temp-file file
(magit-git-insert "diff" rev "-p" typearg args "--" files)))
(magit-refresh))
;;;###autoload
(defun magit-request-pull (url start end)
"Request upstream to pull from your public repository.
URL is the url of your publicly accessible repository.
START is a commit that already is in the upstream repository.
END is the last commit, usually a branch name, which upstream
is asked to pull. START has to be reachable from that commit."
(interactive
(list (magit-get "remote" (magit-read-remote "Remote") "url")
(magit-read-branch-or-commit "Start" (magit-get-upstream-branch))
(magit-read-branch-or-commit "End")))
(let ((dir default-directory))
;; mu4e changes default-directory
(compose-mail)
(setq default-directory dir))
(message-goto-body)
(magit-git-insert "request-pull" start url end)
(set-buffer-modified-p nil))
;;; _
(provide 'magit-patch)
;;; magit-patch.el ends here

19
code/elpa/magit-20220425.1153/magit-pkg.el Normal file
View file

@ -0,0 +1,19 @@
(define-package "magit" "20220425.1153" "A Git porcelain inside Emacs."
'((emacs "25.1")
(compat "28.1.0.4")
(dash "20210826")
(git-commit "20220222")
(magit-section "20220325")
(transient "20220325")
(with-editor "20220318"))
:commit "3cb7f5ba430906bded9e5d9951f5260ab25644d0" :authors
'(("Marius Vollmer" . "marius.vollmer@gmail.com")
("Jonas Bernoulli" . "jonas@bernoul.li"))
:maintainer
'("Jonas Bernoulli" . "jonas@bernoul.li")
:keywords
'("git" "tools" "vc")
:url "https://github.com/magit/magit")
;; Local Variables:
;; no-byte-compile: t
;; End:

1220
code/elpa/magit-20220425.1153/magit-process.el Normal file
View file

File diff suppressed because it is too large Load diff

165
code/elpa/magit-20220425.1153/magit-pull.el Normal file
View file

@ -0,0 +1,165 @@
;;; magit-pull.el --- Update local objects and refs -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library implements pull commands.
;;; Code:
(require 'magit)
;;; Options
(defcustom magit-pull-or-fetch nil
"Whether `magit-pull' also offers some fetch suffixes."
:package-version '(magit . "3.0.0")
:group 'magit-commands
:type 'boolean)
;;; Commands
;;;###autoload (autoload 'magit-pull "magit-pull" nil t)
(transient-define-prefix magit-pull ()
"Pull from another repository."
:man-page "git-pull"
:incompatible '(("--ff-only" "--rebase"))
[:description
(lambda () (if magit-pull-or-fetch "Pull arguments" "Arguments"))
("-f" "Fast-forward only" "--ff-only")
("-r" "Rebase local commits" ("-r" "--rebase"))
("-A" "Autostash" "--autostash" :level 7)]
[:description
(lambda ()
(if-let ((branch (magit-get-current-branch)))
(concat
(propertize "Pull into " 'face 'transient-heading)
(propertize branch 'face 'magit-branch-local)
(propertize " from" 'face 'transient-heading))
(propertize "Pull from" 'face 'transient-heading)))
("p" magit-pull-from-pushremote)
("u" magit-pull-from-upstream)
("e" "elsewhere" magit-pull-branch)]
["Fetch from"
:if-non-nil magit-pull-or-fetch
("f" "remotes" magit-fetch-all-no-prune)
("F" "remotes and prune" magit-fetch-all-prune)]
["Fetch"
:if-non-nil magit-pull-or-fetch
("o" "another branch" magit-fetch-branch)
("s" "explicit refspec" magit-fetch-refspec)
("m" "submodules" magit-fetch-modules)]
["Configure"
("r" magit-branch.<branch>.rebase :if magit-get-current-branch)
("C" "variables..." magit-branch-configure)]
(interactive)
(transient-setup 'magit-pull nil nil :scope (magit-get-current-branch)))
(defun magit-pull-arguments ()
(transient-args 'magit-pull))
;;;###autoload (autoload 'magit-pull-from-pushremote "magit-pull" nil t)
(transient-define-suffix magit-pull-from-pushremote (args)
"Pull from the push-remote of the current branch.
With a prefix argument or when the push-remote is either not
configured or unusable, then let the user first configure the
push-remote."
:if #'magit-get-current-branch
:description #'magit-pull--pushbranch-description
(interactive (list (magit-pull-arguments)))
(pcase-let ((`(,branch ,remote)
(magit--select-push-remote "pull from there")))
(run-hooks 'magit-credential-hook)
(magit-run-git-with-editor "pull" args remote branch)))
(defun magit-pull--pushbranch-description ()
;; Also used by `magit-rebase-onto-pushremote'.
(let* ((branch (magit-get-current-branch))
(target (magit-get-push-branch branch t))
(remote (magit-get-push-remote branch))
(v (magit--push-remote-variable branch t)))
(cond
(target)
((member remote (magit-list-remotes))
(format "%s, replacing non-existent" v))
(remote
(format "%s, replacing invalid" v))
(t
(format "%s, setting that" v)))))
;;;###autoload (autoload 'magit-pull-from-upstream "magit-pull" nil t)
(transient-define-suffix magit-pull-from-upstream (args)
"Pull from the upstream of the current branch.
With a prefix argument or when the upstream is either not
configured or unusable, then let the user first configure
the upstream."
:if #'magit-get-current-branch
:description #'magit-pull--upstream-description
(interactive (list (magit-pull-arguments)))
(let* ((branch (or (magit-get-current-branch)
(user-error "No branch is checked out")))
(remote (magit-get "branch" branch "remote"))
(merge (magit-get "branch" branch "merge")))
(when (or current-prefix-arg
(not (or (magit-get-upstream-branch branch)
(magit--unnamed-upstream-p remote merge))))
(magit-set-upstream-branch
branch (magit-read-upstream-branch
branch (format "Set upstream of %s and pull from there" branch)))
(setq remote (magit-get "branch" branch "remote"))
(setq merge (magit-get "branch" branch "merge")))
(run-hooks 'magit-credential-hook)
(magit-run-git-with-editor "pull" args remote merge)))
(defun magit-pull--upstream-description ()
(and-let* ((branch (magit-get-current-branch)))
(or (magit-get-upstream-branch branch)
(let ((remote (magit-get "branch" branch "remote"))
(merge (magit-get "branch" branch "merge"))
(u (magit--propertize-face "@{upstream}" 'bold)))
(cond
((magit--unnamed-upstream-p remote merge)
(format "%s of %s"
(magit--propertize-face merge 'magit-branch-remote)
(magit--propertize-face remote 'bold)))
((magit--valid-upstream-p remote merge)
(concat u ", replacing non-existent"))
((or remote merge)
(concat u ", replacing invalid"))
(t
(concat u ", setting that")))))))
;;;###autoload
(defun magit-pull-branch (source args)
"Pull from a branch read in the minibuffer."
(interactive (list (magit-read-remote-branch "Pull" nil nil nil t)
(magit-pull-arguments)))
(run-hooks 'magit-credential-hook)
(pcase-let ((`(,remote . ,branch)
(magit-get-tracked source)))
(magit-run-git-with-editor "pull" args remote branch)))
;;; _
(provide 'magit-pull)
;;; magit-pull.el ends here

341
code/elpa/magit-20220425.1153/magit-push.el Normal file
View file

@ -0,0 +1,341 @@
;;; magit-push.el --- Update remote objects and refs -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library implements push commands.
;;; Code:
(require 'magit)
;;; Commands
;;;###autoload (autoload 'magit-push "magit-push" nil t)
(transient-define-prefix magit-push ()
"Push to another repository."
:man-page "git-push"
["Arguments"
("-f" "Force with lease" (nil "--force-with-lease"))
("-F" "Force" ("-f" "--force"))
("-h" "Disable hooks" "--no-verify")
("-n" "Dry run" ("-n" "--dry-run"))
(5 "-u" "Set upstream" "--set-upstream")
(7 "-t" "Follow tags" "--follow-tags")]
[:if magit-get-current-branch
:description (lambda ()
(format (propertize "Push %s to" 'face 'transient-heading)
(propertize (magit-get-current-branch)
'face 'magit-branch-local)))
("p" magit-push-current-to-pushremote)
("u" magit-push-current-to-upstream)
("e" "elsewhere" magit-push-current)]
["Push"
[("o" "another branch" magit-push-other)
("r" "explicit refspecs" magit-push-refspecs)
("m" "matching branches" magit-push-matching)]
[("T" "a tag" magit-push-tag)
("t" "all tags" magit-push-tags)
(6 "n" "a note ref" magit-push-notes-ref)]]
["Configure"
("C" "Set variables..." magit-branch-configure)])
(defun magit-push-arguments ()
(transient-args 'magit-push))
(defun magit-git-push (branch target args)
(run-hooks 'magit-credential-hook)
;; If the remote branch already exists, then we do not have to
;; qualify the target, which we prefer to avoid doing because
;; using the default namespace is wrong in obscure cases.
(pcase-let ((namespace (if (magit-get-tracked target) "" "refs/heads/"))
(`(,remote . ,target)
(magit-split-branch-name target)))
(magit-run-git-async "push" "-v" args remote
(format "%s:%s%s" branch namespace target))))
;;;###autoload (autoload 'magit-push-current-to-pushremote "magit-push" nil t)
(transient-define-suffix magit-push-current-to-pushremote (args)
"Push the current branch to its push-remote.
When the push-remote is not configured, then read the push-remote
from the user, set it, and then push to it. With a prefix
argument the push-remote can be changed before pushed to it."
:if #'magit-get-current-branch
:description #'magit-push--pushbranch-description
(interactive (list (magit-push-arguments)))
(pcase-let ((`(,branch ,remote ,changed)
(magit--select-push-remote "push there")))
(when changed
(magit-confirm 'set-and-push
(string-replace
"%" "%%"
(format "Really use \"%s\" as push-remote and push \"%s\" there"
remote branch))))
(run-hooks 'magit-credential-hook)
(magit-run-git-async "push" "-v" args remote
(format "refs/heads/%s:refs/heads/%s"
branch branch)))) ; see #3847 and #3872
(defun magit-push--pushbranch-description ()
(let* ((branch (magit-get-current-branch))
(target (magit-get-push-branch branch t))
(remote (magit-get-push-remote branch))
(v (magit--push-remote-variable branch t)))
(cond
(target)
((member remote (magit-list-remotes))
(format "%s, creating it"
(magit--propertize-face (concat remote "/" branch)
'magit-branch-remote)))
(remote
(format "%s, replacing invalid" v))
(t
(format "%s, setting that" v)))))
;;;###autoload (autoload 'magit-push-current-to-upstream "magit-push" nil t)
(transient-define-suffix magit-push-current-to-upstream (args)
"Push the current branch to its upstream branch.
With a prefix argument or when the upstream is either not
configured or unusable, then let the user first configure
the upstream."
:if #'magit-get-current-branch
:description #'magit-push--upstream-description
(interactive (list (magit-push-arguments)))
(let* ((branch (or (magit-get-current-branch)
(user-error "No branch is checked out")))
(remote (magit-get "branch" branch "remote"))
(merge (magit-get "branch" branch "merge")))
(when (or current-prefix-arg
(not (or (magit-get-upstream-branch branch)
(magit--unnamed-upstream-p remote merge)
(magit--valid-upstream-p remote merge))))
(let* ((branches (-union (--map (concat it "/" branch)
(magit-list-remotes))
(magit-list-remote-branch-names)))
(upstream (magit-completing-read
(format "Set upstream of %s and push there" branch)
branches nil nil nil 'magit-revision-history
(or (car (member (magit-remote-branch-at-point) branches))
(car (member "origin/master" branches)))))
(upstream* (or (magit-get-tracked upstream)
(magit-split-branch-name upstream))))
(setq remote (car upstream*))
(setq merge (cdr upstream*))
(unless (string-prefix-p "refs/" merge)
;; User selected a non-existent remote-tracking branch.
;; It is very likely, but not certain, that this is the
;; correct thing to do. It is even more likely that it
;; is what the user wants to happen.
(setq merge (concat "refs/heads/" merge)))
(magit-confirm 'set-and-push
(string-replace
"%" "%%"
(format "Really use \"%s\" as upstream and push \"%s\" there"
upstream branch))))
(cl-pushnew "--set-upstream" args :test #'equal))
(run-hooks 'magit-credential-hook)
(magit-run-git-async "push" "-v" args remote (concat branch ":" merge))))
(defun magit-push--upstream-description ()
(and-let* ((branch (magit-get-current-branch)))
(or (magit-get-upstream-branch branch)
(let ((remote (magit-get "branch" branch "remote"))
(merge (magit-get "branch" branch "merge"))
(u (magit--propertize-face "@{upstream}" 'bold)))
(cond
((magit--unnamed-upstream-p remote merge)
(format "%s as %s"
(magit--propertize-face remote 'bold)
(magit--propertize-face merge 'magit-branch-remote)))
((magit--valid-upstream-p remote merge)
(format "%s creating %s"
(magit--propertize-face remote 'magit-branch-remote)
(magit--propertize-face merge 'magit-branch-remote)))
((or remote merge)
(concat u ", creating it and replacing invalid"))
(t
(concat u ", creating it")))))))
;;;###autoload
(defun magit-push-current (target args)
"Push the current branch to a branch read in the minibuffer."
(interactive
(--if-let (magit-get-current-branch)
(list (magit-read-remote-branch (format "Push %s to" it)
nil nil it 'confirm)
(magit-push-arguments))
(user-error "No branch is checked out")))
(magit-git-push (magit-get-current-branch) target args))
;;;###autoload
(defun magit-push-other (source target args)
"Push an arbitrary branch or commit somewhere.
Both the source and the target are read in the minibuffer."
(interactive
(let ((source (magit-read-local-branch-or-commit "Push")))
(list source
(magit-read-remote-branch
(format "Push %s to" source) nil
(if (magit-local-branch-p source)
(or (magit-get-push-branch source)
(magit-get-upstream-branch source))
(and (magit-rev-ancestor-p source "HEAD")
(or (magit-get-push-branch)
(magit-get-upstream-branch))))
source 'confirm)
(magit-push-arguments))))
(magit-git-push source target args))
(defvar magit-push-refspecs-history nil)
;;;###autoload
(defun magit-push-refspecs (remote refspecs args)
"Push one or multiple REFSPECS to a REMOTE.
Both the REMOTE and the REFSPECS are read in the minibuffer. To
use multiple REFSPECS, separate them with commas. Completion is
only available for the part before the colon, or when no colon
is used."
(interactive
(list (magit-read-remote "Push to remote")
(magit-completing-read-multiple*
"Push refspec,s: "
(cons "HEAD" (magit-list-local-branch-names))
nil nil nil 'magit-push-refspecs-history)
(magit-push-arguments)))
(run-hooks 'magit-credential-hook)
(magit-run-git-async "push" "-v" args remote refspecs))
;;;###autoload
(defun magit-push-matching (remote &optional args)
"Push all matching branches to another repository.
If multiple remotes exist, then read one from the user.
If just one exists, use that without requiring confirmation."
(interactive (list (magit-read-remote "Push matching branches to" nil t)
(magit-push-arguments)))
(run-hooks 'magit-credential-hook)
(magit-run-git-async "push" "-v" args remote ":"))
;;;###autoload
(defun magit-push-tags (remote &optional args)
"Push all tags to another repository.
If only one remote exists, then push to that. Otherwise prompt
for a remote, offering the remote configured for the current
branch as default."
(interactive (list (magit-read-remote "Push tags to remote" nil t)
(magit-push-arguments)))
(run-hooks 'magit-credential-hook)
(magit-run-git-async "push" remote "--tags" args))
;;;###autoload
(defun magit-push-tag (tag remote &optional args)
"Push a tag to another repository."
(interactive
(let ((tag (magit-read-tag "Push tag")))
(list tag (magit-read-remote (format "Push %s to remote" tag) nil t)
(magit-push-arguments))))
(run-hooks 'magit-credential-hook)
(magit-run-git-async "push" remote tag args))
;;;###autoload
(defun magit-push-notes-ref (ref remote &optional args)
"Push a notes ref to another repository."
(interactive
(let ((note (magit-notes-read-ref "Push notes" nil nil)))
(list note
(magit-read-remote (format "Push %s to remote" note) nil t)
(magit-push-arguments))))
(run-hooks 'magit-credential-hook)
(magit-run-git-async "push" remote ref args))
;;;###autoload (autoload 'magit-push-implicitly "magit-push" nil t)
(transient-define-suffix magit-push-implicitly (args)
"Push somewhere without using an explicit refspec.
This command simply runs \"git push -v [ARGS]\". ARGS are the
arguments specified in the popup buffer. No explicit refspec
arguments are used. Instead the behavior depends on at least
these Git variables: `push.default', `remote.pushDefault',
`branch.<branch>.pushRemote', `branch.<branch>.remote',
`branch.<branch>.merge', and `remote.<remote>.push'.
If you add this suffix to a transient prefix without explicitly
specifying the description, then an attempt is made to predict
what this command will do. For example:
(transient-insert-suffix \\='magit-push \"p\"
\\='(\"i\" magit-push-implicitly))"
:description #'magit-push-implicitly--desc
(interactive (list (magit-push-arguments)))
(run-hooks 'magit-credential-hook)
(magit-run-git-async "push" "-v" args))
(defun magit-push-implicitly--desc ()
(let ((default (magit-get "push.default")))
(unless (equal default "nothing")
(or (and-let* ((remote (or (magit-get-remote)
(magit-primary-remote)))
(refspec (magit-get "remote" remote "push")))
(format "%s using %s"
(magit--propertize-face remote 'magit-branch-remote)
(magit--propertize-face refspec 'bold)))
(and-let* ((upstream (and (not (magit-get-push-branch))
(magit-get-upstream-branch))))
(format "%s aka %s\n"
(magit-branch-set-face upstream)
(magit--propertize-face "@{upstream}" 'bold)))
(and-let* ((push-branch (magit-get-push-branch)))
(format "%s aka %s\n"
(magit-branch-set-face push-branch)
(magit--propertize-face "pushRemote" 'bold)))
(and-let* ((push-branch (magit-get-@{push}-branch)))
(format "%s aka %s\n"
(magit-branch-set-face push-branch)
(magit--propertize-face "@{push}" 'bold)))
(format "using %s (%s is %s)\n"
(magit--propertize-face "git push" 'bold)
(magit--propertize-face "push.default" 'bold)
(magit--propertize-face default 'bold))))))
;;;###autoload
(defun magit-push-to-remote (remote args)
"Push to REMOTE without using an explicit refspec.
The REMOTE is read in the minibuffer.
This command simply runs \"git push -v [ARGS] REMOTE\". ARGS
are the arguments specified in the popup buffer. No refspec
arguments are used. Instead the behavior depends on at least
these Git variables: `push.default', `remote.pushDefault',
`branch.<branch>.pushRemote', `branch.<branch>.remote',
`branch.<branch>.merge', and `remote.<remote>.push'."
(interactive (list (magit-read-remote "Push to remote")
(magit-push-arguments)))
(run-hooks 'magit-credential-hook)
(magit-run-git-async "push" "-v" args remote))
(defun magit-push-to-remote--desc ()
(format "using %s\n" (magit--propertize-face "git push <remote>" 'bold)))
;;; _
(provide 'magit-push)
;;; magit-push.el ends here

210
code/elpa/magit-20220425.1153/magit-reflog.el Normal file
View file

@ -0,0 +1,210 @@
;;; magit-reflog.el --- Inspect ref history -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library implements support for looking at Git reflogs.
;;; Code:
(require 'magit-core)
(require 'magit-log)
;;; Options
(defcustom magit-reflog-limit 256
"Maximal number of entries initially shown in reflog buffers.
The limit in the current buffer can be changed using \"+\"
and \"-\"."
:package-version '(magit . "3.0.0")
:group 'magit-commands
:type 'number)
(defcustom magit-reflog-margin
(list (nth 0 magit-log-margin)
(nth 1 magit-log-margin)
'magit-log-margin-width nil
(nth 4 magit-log-margin))
"Format of the margin in `magit-reflog-mode' buffers.
The value has the form (INIT STYLE WIDTH AUTHOR AUTHOR-WIDTH).
If INIT is non-nil, then the margin is shown initially.
STYLE controls how to format the author or committer date.
It can be one of `age' (to show the age of the commit),
`age-abbreviated' (to abbreviate the time unit to a character),
or a string (suitable for `format-time-string') to show the
actual date. Option `magit-log-margin-show-committer-date'
controls which date is being displayed.
WIDTH controls the width of the margin. This exists for forward
compatibility and currently the value should not be changed.
AUTHOR controls whether the name of the author is also shown by
default.
AUTHOR-WIDTH has to be an integer. When the name of the author
is shown, then this specifies how much space is used to do so."
:package-version '(magit . "2.9.0")
:group 'magit-log
:group 'magit-margin
:type magit-log-margin--custom-type
:initialize #'magit-custom-initialize-reset
:set-after '(magit-log-margin)
:set (apply-partially #'magit-margin-set-variable 'magit-reflog-mode))
;;; Faces
(defface magit-reflog-commit '((t :foreground "green"))
"Face for commit commands in reflogs."
:group 'magit-faces)
(defface magit-reflog-amend '((t :foreground "magenta"))
"Face for amend commands in reflogs."
:group 'magit-faces)
(defface magit-reflog-merge '((t :foreground "green"))
"Face for merge, checkout and branch commands in reflogs."
:group 'magit-faces)
(defface magit-reflog-checkout '((t :foreground "blue"))
"Face for checkout commands in reflogs."
:group 'magit-faces)
(defface magit-reflog-reset '((t :foreground "red"))
"Face for reset commands in reflogs."
:group 'magit-faces)
(defface magit-reflog-rebase '((t :foreground "magenta"))
"Face for rebase commands in reflogs."
:group 'magit-faces)
(defface magit-reflog-cherry-pick '((t :foreground "green"))
"Face for cherry-pick commands in reflogs."
:group 'magit-faces)
(defface magit-reflog-remote '((t :foreground "cyan"))
"Face for pull and clone commands in reflogs."
:group 'magit-faces)
(defface magit-reflog-other '((t :foreground "cyan"))
"Face for other commands in reflogs."
:group 'magit-faces)
;;; Commands
;;;###autoload
(defun magit-reflog-current ()
"Display the reflog of the current branch.
If `HEAD' is detached, then show the reflog for that instead."
(interactive)
(magit-reflog-setup-buffer (or (magit-get-current-branch) "HEAD")))
;;;###autoload
(defun magit-reflog-other (ref)
"Display the reflog of a branch or another ref."
(interactive (list (magit-read-local-branch-or-ref "Show reflog for")))
(magit-reflog-setup-buffer ref))
;;;###autoload
(defun magit-reflog-head ()
"Display the `HEAD' reflog."
(interactive)
(magit-reflog-setup-buffer "HEAD"))
;;; Mode
(defvar magit-reflog-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map magit-log-mode-map)
(define-key map (kbd "C-c C-n") #'undefined)
(define-key map (kbd "L") #'magit-margin-settings)
map)
"Keymap for `magit-reflog-mode'.")
(define-derived-mode magit-reflog-mode magit-mode "Magit Reflog"
"Mode for looking at Git reflog.
This mode is documented in info node `(magit)Reflog'.
\\<magit-mode-map>\
Type \\[magit-refresh] to refresh the current buffer.
Type \\[magit-visit-thing] or \\[magit-diff-show-or-scroll-up] \
to visit the commit at point.
Type \\[magit-cherry-pick] to apply the commit at point.
Type \\[magit-reset] to reset `HEAD' to the commit at point.
\\{magit-reflog-mode-map}"
:group 'magit-log
(hack-dir-local-variables-non-file-buffer)
(setq magit--imenu-item-types 'commit))
(defun magit-reflog-setup-buffer (ref)
(require 'magit)
(magit-setup-buffer #'magit-reflog-mode nil
(magit-buffer-refname ref)
(magit-buffer-log-args (list (format "-n%s" magit-reflog-limit)))))
(defun magit-reflog-refresh-buffer ()
(magit-set-header-line-format (concat "Reflog for " magit-buffer-refname))
(magit-insert-section (reflogbuf)
(magit-git-wash (apply-partially #'magit-log-wash-log 'reflog)
"reflog" "show" "--format=%h%x00%aN%x00%gd%x00%gs" "--date=raw"
magit-buffer-log-args magit-buffer-refname "--")))
(cl-defmethod magit-buffer-value (&context (major-mode magit-reflog-mode))
magit-buffer-refname)
(defvar magit-reflog-labels
'(("commit" . magit-reflog-commit)
("amend" . magit-reflog-amend)
("merge" . magit-reflog-merge)
("checkout" . magit-reflog-checkout)
("branch" . magit-reflog-checkout)
("reset" . magit-reflog-reset)
("rebase" . magit-reflog-rebase)
("cherry-pick" . magit-reflog-cherry-pick)
("initial" . magit-reflog-commit)
("pull" . magit-reflog-remote)
("clone" . magit-reflog-remote)
("autosave" . magit-reflog-commit)
("restart" . magit-reflog-reset)))
(defun magit-reflog-format-subject (subject)
(let* ((match (string-match magit-reflog-subject-re subject))
(command (and match (match-string 1 subject)))
(option (and match (match-string 2 subject)))
(type (and match (match-string 3 subject)))
(label (if (string= command "commit")
(or type command)
command))
(text (if (string= command "commit")
label
(mapconcat #'identity
(delq nil (list command option type))
" "))))
(format "%-16s "
(magit--propertize-face
text (or (cdr (assoc label magit-reflog-labels))
'magit-reflog-other)))))
;;; _
(provide 'magit-reflog)
;;; magit-reflog.el ends here

774
code/elpa/magit-20220425.1153/magit-refs.el Normal file
View file

@ -0,0 +1,774 @@
;;; magit-refs.el --- Listing references -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library implements support for listing references in a buffer.
;;; Code:
(require 'magit)
;;; Options
(defgroup magit-refs nil
"Inspect and manipulate Git branches and tags."
:link '(info-link "(magit)References Buffer")
:group 'magit-modes)
(defcustom magit-refs-mode-hook nil
"Hook run after entering Magit-Refs mode."
:package-version '(magit . "2.1.0")
:group 'magit-refs
:type 'hook)
(defcustom magit-refs-sections-hook
'(magit-insert-error-header
magit-insert-branch-description
magit-insert-local-branches
magit-insert-remote-branches
magit-insert-tags)
"Hook run to insert sections into a references buffer."
:package-version '(magit . "2.1.0")
:group 'magit-refs
:type 'hook)
(defcustom magit-refs-show-commit-count nil
"Whether to show commit counts in Magit-Refs mode buffers.
all Show counts for branches and tags.
branch Show counts for branches only.
nil Never show counts.
To change the value in an existing buffer use the command
`magit-refs-set-show-commit-count'."
:package-version '(magit . "2.1.0")
:group 'magit-refs
:safe (lambda (val) (memq val '(all branch nil)))
:type '(choice (const all :tag "For branches and tags")
(const branch :tag "For branches only")
(const nil :tag "Never")))
(put 'magit-refs-show-commit-count 'safe-local-variable 'symbolp)
(put 'magit-refs-show-commit-count 'permanent-local t)
(defcustom magit-refs-pad-commit-counts nil
"Whether to pad all counts on all sides in `magit-refs-mode' buffers.
If this is nil, then some commit counts are displayed right next
to one of the branches that appear next to the count, without any
space in between. This might look bad if the branch name faces
look too similar to `magit-dimmed'.
If this is non-nil, then spaces are placed on both sides of all
commit counts."
:package-version '(magit . "2.12.0")
:group 'magit-refs
:type 'boolean)
(defvar magit-refs-show-push-remote nil
"Whether to show the push-remotes of local branches.
Also show the commits that the local branch is ahead and behind
the push-target. Unfortunately there is a bug in Git that makes
this useless (the commits ahead and behind the upstream are
shown), so this isn't enabled yet.")
(defcustom magit-refs-show-remote-prefix nil
"Whether to show the remote prefix in lists of remote branches.
This is redundant because the name of the remote is already shown
in the heading preceding the list of its branches."
:package-version '(magit . "2.12.0")
:group 'magit-refs
:type 'boolean)
(defcustom magit-refs-margin
(list nil
(nth 1 magit-log-margin)
'magit-log-margin-width nil
(nth 4 magit-log-margin))
"Format of the margin in `magit-refs-mode' buffers.
The value has the form (INIT STYLE WIDTH AUTHOR AUTHOR-WIDTH).
If INIT is non-nil, then the margin is shown initially.
STYLE controls how to format the author or committer date.
It can be one of `age' (to show the age of the commit),
`age-abbreviated' (to abbreviate the time unit to a character),
or a string (suitable for `format-time-string') to show the
actual date. Option `magit-log-margin-show-committer-date'
controls which date is being displayed.
WIDTH controls the width of the margin. This exists for forward
compatibility and currently the value should not be changed.
AUTHOR controls whether the name of the author is also shown by
default.
AUTHOR-WIDTH has to be an integer. When the name of the author
is shown, then this specifies how much space is used to do so."
:package-version '(magit . "2.9.0")
:group 'magit-refs
:group 'magit-margin
:safe (lambda (val) (memq val '(all branch nil)))
:type magit-log-margin--custom-type
:initialize #'magit-custom-initialize-reset
:set-after '(magit-log-margin)
:set (apply-partially #'magit-margin-set-variable 'magit-refs-mode))
(defcustom magit-refs-margin-for-tags nil
"Whether to show information about tags in the margin.
This is disabled by default because it is slow if there are many
tags."
:package-version '(magit . "2.9.0")
:group 'magit-refs
:group 'magit-margin
:type 'boolean)
(defcustom magit-refs-primary-column-width (cons 16 32)
"Width of the focus column in `magit-refs-mode' buffers.
The primary column is the column that contains the name of the
branch that the current row is about.
If this is an integer, then the column is that many columns wide.
Otherwise it has to be a cons-cell of two integers. The first
specifies the minimal width, the second the maximal width. In that
case the actual width is determined using the length of the names
of the shown local branches. (Remote branches and tags are not
taken into account when calculating to optimal width.)"
:package-version '(magit . "2.12.0")
:group 'magit-refs
:type '(choice (integer :tag "Constant wide")
(cons :tag "Wide constrains"
(integer :tag "Minimum")
(integer :tag "Maximum"))))
(defcustom magit-refs-focus-column-width 5
"Width of the focus column in `magit-refs-mode' buffers.
The focus column is the first column, which marks one
branch (usually the current branch) as the focused branch using
\"*\" or \"@\". For each other reference, this column optionally
shows how many commits it is ahead of the focused branch and \"<\", or
if it isn't ahead then the commits it is behind and \">\", or if it
isn't behind either, then a \"=\".
This column may also display only \"*\" or \"@\" for the focused
branch, in which case this option is ignored. Use \"L v\" to
change the verbosity of this column."
:package-version '(magit . "2.12.0")
:group 'magit-refs
:type 'integer)
(defcustom magit-refs-filter-alist nil
"Alist controlling which refs are omitted from `magit-refs-mode' buffers.
The purpose of this option is to forgo displaying certain refs
based on their name. If you want to not display any refs of a
certain type, then you should remove the appropriate function
from `magit-refs-sections-hook' instead.
All keys are tried in order until one matches. Then its value
is used and subsequent elements are ignored. If the value is
non-nil, then the reference is displayed, otherwise it is not.
If no element matches, then the reference is displayed.
A key can either be a regular expression that the refname has to
match, or a function that takes the refname as only argument and
returns a boolean. A remote branch such as \"origin/master\" is
displayed as just \"master\", however for this comparison the
former is used."
:package-version '(magit . "2.12.0")
:group 'magit-refs
:type '(alist :key-type (choice :tag "Key" regexp function)
:value-type (boolean :tag "Value"
:on "show (non-nil)"
:off "omit (nil)")))
(defcustom magit-visit-ref-behavior nil
"Control how `magit-visit-ref' behaves in `magit-refs-mode' buffers.
By default `magit-visit-ref' behaves like `magit-show-commit',
in all buffers, including `magit-refs-mode' buffers. When the
type of the section at point is `commit' then \"RET\" is bound to
`magit-show-commit', and when the type is either `branch' or
`tag' then it is bound to `magit-visit-ref'.
\"RET\" is one of Magit's most essential keys and at least by
default it should behave consistently across all of Magit,
especially because users quickly learn that it does something
very harmless; it shows more information about the thing at point
in another buffer.
However \"RET\" used to behave differently in `magit-refs-mode'
buffers, doing surprising things, some of which cannot really be
described as \"visit this thing\". If you have grown accustomed
to such inconsistent, but to you useful, behavior, then you can
restore that by adding one or more of the below symbols to the
value of this option. But keep in mind that by doing so you
don't only introduce inconsistencies, you also lose some
functionality and might have to resort to `M-x magit-show-commit'
to get it back.
`magit-visit-ref' looks for these symbols in the order in which
they are described here. If the presence of a symbol applies to
the current situation, then the symbols that follow do not affect
the outcome.
`focus-on-ref'
With a prefix argument update the buffer to show commit counts
and lists of cherry commits relative to the reference at point
instead of relative to the current buffer or `HEAD'.
Instead of adding this symbol, consider pressing \"C-u y o RET\".
`create-branch'
If point is on a remote branch, then create a new local branch
with the same name, use the remote branch as its upstream, and
then check out the local branch.
Instead of adding this symbol, consider pressing \"b c RET RET\",
like you would do in other buffers.
`checkout-any'
Check out the reference at point. If that reference is a tag
or a remote branch, then this results in a detached `HEAD'.
Instead of adding this symbol, consider pressing \"b b RET\",
like you would do in other buffers.
`checkout-branch'
Check out the local branch at point.
Instead of adding this symbol, consider pressing \"b b RET\",
like you would do in other buffers."
:package-version '(magit . "2.9.0")
:group 'magit-refs
:group 'magit-commands
:options '(focus-on-ref create-branch checkout-any checkout-branch)
:type '(list :convert-widget custom-hook-convert-widget))
;;; Mode
(defvar magit-refs-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map magit-mode-map)
(define-key map (kbd "C-y") #'magit-refs-set-show-commit-count)
(define-key map (kbd "L") #'magit-margin-settings)
map)
"Keymap for `magit-refs-mode'.")
(define-derived-mode magit-refs-mode magit-mode "Magit Refs"
"Mode which lists and compares references.
This mode is documented in info node `(magit)References Buffer'.
\\<magit-mode-map>\
Type \\[magit-refresh] to refresh the current buffer.
Type \\[magit-section-toggle] to expand or hide the section at point.
Type \\[magit-visit-thing] or \\[magit-diff-show-or-scroll-up] \
to visit the commit or branch at point.
Type \\[magit-branch] to see available branch commands.
Type \\[magit-merge] to merge the branch or commit at point.
Type \\[magit-cherry-pick] to apply the commit at point.
Type \\[magit-reset] to reset `HEAD' to the commit at point.
\\{magit-refs-mode-map}"
:group 'magit-refs
(hack-dir-local-variables-non-file-buffer)
(setq magit--imenu-group-types '(local remote tags)))
(defun magit-refs-setup-buffer (ref args)
(magit-setup-buffer #'magit-refs-mode nil
(magit-buffer-upstream ref)
(magit-buffer-arguments args)))
(defun magit-refs-refresh-buffer ()
(setq magit-set-buffer-margin-refresh (not (magit-buffer-margin-p)))
(unless (magit-rev-verify magit-buffer-upstream)
(setq magit-refs-show-commit-count nil))
(magit-set-header-line-format
(format "%s %s" magit-buffer-upstream
(mapconcat #'identity magit-buffer-arguments " ")))
(magit-insert-section (branchbuf)
(magit-run-section-hook 'magit-refs-sections-hook))
(add-hook 'kill-buffer-hook #'magit-preserve-section-visibility-cache))
(cl-defmethod magit-buffer-value (&context (major-mode magit-refs-mode))
(cons magit-buffer-upstream magit-buffer-arguments))
;;; Commands
;;;###autoload (autoload 'magit-show-refs "magit-refs" nil t)
(transient-define-prefix magit-show-refs (&optional transient)
"List and compare references in a dedicated buffer."
:man-page "git-branch"
:value (lambda ()
(magit-show-refs-arguments magit-prefix-use-buffer-arguments))
["Arguments"
(magit-for-each-ref:--contains)
("-M" "Merged" "--merged=" magit-transient-read-revision)
("-m" "Merged to HEAD" "--merged")
("-N" "Not merged" "--no-merged=" magit-transient-read-revision)
("-n" "Not merged to HEAD" "--no-merged")
(magit-for-each-ref:--sort)]
["Actions"
("y" "Show refs, comparing them with HEAD" magit-show-refs-head)
("c" "Show refs, comparing them with current branch" magit-show-refs-current)
("o" "Show refs, comparing them with other branch" magit-show-refs-other)
("r" "Show refs, changing commit count display"
magit-refs-set-show-commit-count)]
(interactive (list (or (derived-mode-p 'magit-refs-mode)
current-prefix-arg)))
(if transient
(transient-setup 'magit-show-refs)
(magit-refs-setup-buffer "HEAD" (magit-show-refs-arguments))))
(defun magit-show-refs-arguments (&optional use-buffer-args)
(unless use-buffer-args
(setq use-buffer-args magit-direct-use-buffer-arguments))
(let (args)
(cond
((eq transient-current-command 'magit-show-refs)
(setq args (transient-args 'magit-show-refs)))
((eq major-mode 'magit-refs-mode)
(setq args magit-buffer-arguments))
((and (memq use-buffer-args '(always selected))
(when-let* ((buffer (magit-get-mode-buffer ;debbugs#31840
'magit-refs-mode nil
(eq use-buffer-args 'selected))))
(setq args (buffer-local-value 'magit-buffer-arguments buffer))
t)))
(t
(setq args (alist-get 'magit-show-refs transient-values))))
args))
(transient-define-argument magit-for-each-ref:--contains ()
:description "Contains"
:class 'transient-option
:key "-c"
:argument "--contains="
:reader #'magit-transient-read-revision)
(transient-define-argument magit-for-each-ref:--sort ()
:description "Sort"
:class 'transient-option
:key "-s"
:argument "--sort="
:reader #'magit-read-ref-sort)
(defun magit-read-ref-sort (prompt initial-input _history)
(magit-completing-read prompt
'("-committerdate" "-authordate"
"committerdate" "authordate")
nil nil initial-input))
;;;###autoload
(defun magit-show-refs-head (&optional args)
"List and compare references in a dedicated buffer.
Compared with `HEAD'."
(interactive (list (magit-show-refs-arguments)))
(magit-refs-setup-buffer "HEAD" args))
;;;###autoload
(defun magit-show-refs-current (&optional args)
"List and compare references in a dedicated buffer.
Compare with the current branch or `HEAD' if it is detached."
(interactive (list (magit-show-refs-arguments)))
(magit-refs-setup-buffer (magit-get-current-branch) args))
;;;###autoload
(defun magit-show-refs-other (&optional ref args)
"List and compare references in a dedicated buffer.
Compared with a branch read from the user."
(interactive (list (magit-read-other-branch "Compare with")
(magit-show-refs-arguments)))
(magit-refs-setup-buffer ref args))
(defun magit-refs-set-show-commit-count ()
"Change for which refs the commit count is shown."
(interactive)
(setq-local magit-refs-show-commit-count
(magit-read-char-case "Show commit counts for " nil
(?a "[a]ll refs" 'all)
(?b "[b]ranches only" t)
(?n "[n]othing" nil)))
(magit-refresh))
(defun magit-visit-ref ()
"Visit the reference or revision at point in another buffer.
If there is no revision at point or with a prefix argument prompt
for a revision.
This command behaves just like `magit-show-commit', except if
point is on a reference in a `magit-refs-mode' buffer (a buffer
listing branches and tags), in which case the behavior may be
different, but only if you have customized the option
`magit-visit-ref-behavior' (which see). When invoked from a
menu this command always behaves like `magit-show-commit'."
(interactive)
(if (and (derived-mode-p 'magit-refs-mode)
(magit-section-match '(branch tag))
(magit-menu-position))
(let ((ref (oref (magit-current-section) value)))
(cond (current-prefix-arg
(cond ((memq 'focus-on-ref magit-visit-ref-behavior)
(magit-refs-setup-buffer ref (magit-show-refs-arguments)))
(magit-visit-ref-behavior
;; Don't prompt for commit to visit.
(let ((current-prefix-arg nil))
(call-interactively #'magit-show-commit)))))
((and (memq 'create-branch magit-visit-ref-behavior)
(magit-section-match [branch remote]))
(let ((branch (cdr (magit-split-branch-name ref))))
(if (magit-branch-p branch)
(if (magit-rev-eq branch ref)
(magit-call-git "checkout" branch)
(setq branch (propertize branch 'face 'magit-branch-local))
(setq ref (propertize ref 'face 'magit-branch-remote))
(pcase (prog1 (read-char-choice (format (propertize "\
Branch %s already exists.
[c]heckout %s as-is
[r]reset %s to %s and checkout %s
[a]bort " 'face 'minibuffer-prompt) branch branch branch ref branch)
'(?c ?r ?a))
(message "")) ; otherwise prompt sticks
(?c (magit-call-git "checkout" branch))
(?r (magit-call-git "checkout" "-B" branch ref))
(?a (user-error "Abort"))))
(magit-call-git "checkout" "-b" branch ref))
(setq magit-buffer-upstream branch)
(magit-refresh)))
((or (memq 'checkout-any magit-visit-ref-behavior)
(and (memq 'checkout-branch magit-visit-ref-behavior)
(magit-section-match [branch local])))
(magit-call-git "checkout" ref)
(setq magit-buffer-upstream ref)
(magit-refresh))
(t
(call-interactively #'magit-show-commit))))
(call-interactively #'magit-show-commit)))
;;; Sections
(defvar magit-remote-section-map
(let ((map (make-sparse-keymap)))
(magit-menu-set map [magit-delete-thing] #'magit-remote-remove "Remove %m")
(magit-menu-set map [magit-file-rename] #'magit-remote-rename "Rename %s")
map)
"Keymap for `remote' sections.")
(defvar magit-branch-section-map
(let ((map (make-sparse-keymap)))
(magit-menu-set map [magit-visit-thing] #'magit-visit-ref "Visit commit")
(magit-menu-set map [magit-delete-thing] #'magit-branch-delete "Delete %m")
(magit-menu-set map [magit-file-rename] #'magit-branch-rename "Rename %s")
map)
"Keymap for `branch' sections.")
(defvar magit-tag-section-map
(let ((map (make-sparse-keymap)))
(magit-menu-set map [magit-visit-thing] #'magit-visit-ref "Visit %s")
(magit-menu-set map [magit-delete-thing] #'magit-tag-delete "Delete %m")
map)
"Keymap for `tag' sections.")
(defun magit--painted-branch-as-menu-section (section)
(and-let* ((branch (and (magit-section-match 'commit)
(magit--painted-branch-at-point))))
(let ((dummy (magit-section :type 'branch :value branch)))
(oset dummy keymap magit-branch-section-map)
(dolist (slot '(start content hidden parent children))
(when (slot-boundp section slot)
(setf (eieio-oref dummy slot)
(eieio-oref section slot))))
dummy)))
(add-hook 'magit-menu-alternative-section-hook
#'magit--painted-branch-as-menu-section)
(defun magit-insert-branch-description ()
"Insert header containing the description of the current branch.
Insert a header line with the name and description of the
current branch. The description is taken from the Git variable
`branch.<NAME>.description'; if that is undefined then no header
line is inserted at all."
(when-let* ((branch (magit-get-current-branch))
(desc (magit-get "branch" branch "description"))
(desc (split-string desc "\n")))
(when (equal (car (last desc)) "")
(setq desc (butlast desc)))
(magit-insert-section (branchdesc branch t)
(magit-insert-heading branch ": " (car desc))
(when (cdr desc)
(insert (mapconcat #'identity (cdr desc) "\n"))
(insert "\n\n")))))
(defun magit-insert-tags ()
"Insert sections showing all tags."
(when-let ((tags (magit-git-lines "tag" "--list" "-n" magit-buffer-arguments)))
(let ((_head (magit-rev-parse "HEAD")))
(magit-insert-section (tags)
(magit-insert-heading "Tags:")
(dolist (tag tags)
(string-match "^\\([^ \t]+\\)[ \t]+\\([^ \t\n].*\\)?" tag)
(let ((tag (match-string 1 tag))
(msg (match-string 2 tag)))
(when (magit-refs--insert-refname-p tag)
(magit-insert-section (tag tag t)
(magit-insert-heading
(magit-refs--format-focus-column tag 'tag)
(propertize tag 'font-lock-face 'magit-tag)
(make-string
(max 1 (- (if (consp magit-refs-primary-column-width)
(car magit-refs-primary-column-width)
magit-refs-primary-column-width)
(length tag)))
?\s)
(and msg (magit-log-propertize-keywords nil msg)))
(when (and magit-refs-margin-for-tags (magit-buffer-margin-p))
(magit-refs--format-margin tag))
(magit-refs--insert-cherry-commits tag)))))
(insert ?\n)
(magit-make-margin-overlay nil t)))))
(defun magit-insert-remote-branches ()
"Insert sections showing all remote-tracking branches."
(dolist (remote (magit-list-remotes))
(magit-insert-section (remote remote)
(magit-insert-heading
(let ((pull (magit-get "remote" remote "url"))
(push (magit-get "remote" remote "pushurl")))
(format (propertize "Remote %s (%s):"
'font-lock-face 'magit-section-heading)
(propertize remote 'font-lock-face 'magit-branch-remote)
(concat pull (and pull push ", ") push))))
(let (head)
(dolist (line (magit-git-lines "for-each-ref" "--format=\
%(symref:short)%00%(refname:short)%00%(refname)%00%(subject)"
(concat "refs/remotes/" remote)
magit-buffer-arguments))
(pcase-let ((`(,head-branch ,branch ,ref ,msg)
(-replace "" nil (split-string line "\0"))))
(if head-branch
(progn (cl-assert (equal branch (concat remote "/HEAD")))
(setq head head-branch))
(when (magit-refs--insert-refname-p branch)
(magit-insert-section (branch branch t)
(let ((headp (equal branch head))
(abbrev (if magit-refs-show-remote-prefix
branch
(substring branch (1+ (length remote))))))
(magit-insert-heading
(magit-refs--format-focus-column branch)
(magit-refs--propertize-branch
abbrev ref (and headp 'magit-branch-remote-head))
(make-string
(max 1 (- (if (consp magit-refs-primary-column-width)
(car magit-refs-primary-column-width)
magit-refs-primary-column-width)
(length abbrev)))
?\s)
(and msg (magit-log-propertize-keywords nil msg))))
(when (magit-buffer-margin-p)
(magit-refs--format-margin branch))
(magit-refs--insert-cherry-commits branch)))))))
(insert ?\n)
(magit-make-margin-overlay nil t))))
(defun magit-insert-local-branches ()
"Insert sections showing all local branches."
(magit-insert-section (local nil)
(magit-insert-heading "Branches:")
(dolist (line (magit-refs--format-local-branches))
(pcase-let ((`(,branch . ,strings) line))
(magit-insert-section
((eval (if branch 'branch 'commit))
(or branch (magit-rev-parse "HEAD"))
t)
(apply #'magit-insert-heading strings)
(when (magit-buffer-margin-p)
(magit-refs--format-margin branch))
(magit-refs--insert-cherry-commits branch))))
(insert ?\n)
(magit-make-margin-overlay nil t)))
(defun magit-refs--format-local-branches ()
(let ((lines (-keep #'magit-refs--format-local-branch
(magit-git-lines
"for-each-ref"
(concat "--format=\
%(HEAD)%00%(refname:short)%00%(refname)%00\
%(upstream:short)%00%(upstream)%00%(upstream:track)%00"
(if magit-refs-show-push-remote "\
%(push:remotename)%00%(push)%00%(push:track)%00%(subject)"
"%00%00%00%(subject)"))
"refs/heads"
magit-buffer-arguments))))
(unless (magit-get-current-branch)
(push (magit-refs--format-local-branch
(concat "*\0\0\0\0\0\0\0\0" (magit-rev-format "%s")))
lines))
(setq-local magit-refs-primary-column-width
(let ((def (default-value 'magit-refs-primary-column-width)))
(if (atom def)
def
(pcase-let ((`(,min . ,max) def))
(min max (apply #'max min (mapcar #'car lines)))))))
(mapcar (pcase-lambda (`(,_ ,branch ,focus ,branch-desc ,u:ahead ,p:ahead
,u:behind ,upstream ,p:behind ,push ,msg))
(list branch focus branch-desc u:ahead p:ahead
(make-string (max 1 (- magit-refs-primary-column-width
(length (concat branch-desc
u:ahead
p:ahead
u:behind))))
?\s)
u:behind upstream p:behind push
msg))
lines)))
(defun magit-refs--format-local-branch (line)
(pcase-let ((`(,head ,branch ,ref ,upstream ,u:ref ,u:track
,push ,p:ref ,p:track ,msg)
(-replace "" nil (split-string line "\0"))))
(when (or (not branch)
(magit-refs--insert-refname-p branch))
(let* ((headp (equal head "*"))
(pushp (and push
magit-refs-show-push-remote
(magit-rev-verify p:ref)
(not (equal p:ref u:ref))))
(branch-desc
(if branch
(magit-refs--propertize-branch
branch ref (and headp 'magit-branch-current))
(magit--propertize-face "(detached)" 'magit-branch-warning)))
(u:ahead (and u:track
(string-match "ahead \\([0-9]+\\)" u:track)
(magit--propertize-face
(concat (and magit-refs-pad-commit-counts " ")
(match-string 1 u:track)
">")
'magit-dimmed)))
(u:behind (and u:track
(string-match "behind \\([0-9]+\\)" u:track)
(magit--propertize-face
(concat "<"
(match-string 1 u:track)
(and magit-refs-pad-commit-counts " "))
'magit-dimmed)))
(p:ahead (and pushp p:track
(string-match "ahead \\([0-9]+\\)" p:track)
(magit--propertize-face
(concat (match-string 1 p:track)
">"
(and magit-refs-pad-commit-counts " "))
'magit-branch-remote)))
(p:behind (and pushp p:track
(string-match "behind \\([0-9]+\\)" p:track)
(magit--propertize-face
(concat "<"
(match-string 1 p:track)
(and magit-refs-pad-commit-counts " "))
'magit-dimmed))))
(list (1+ (length (concat branch-desc u:ahead p:ahead u:behind)))
branch
(magit-refs--format-focus-column branch headp)
branch-desc u:ahead p:ahead u:behind
(and upstream
(concat (if (equal u:track "[gone]")
(magit--propertize-face upstream 'error)
(magit-refs--propertize-branch upstream u:ref))
" "))
(and pushp
(concat p:behind
(magit--propertize-face
push 'magit-branch-remote)
" "))
(and msg (magit-log-propertize-keywords nil msg)))))))
(defun magit-refs--format-focus-column (ref &optional type)
(let ((focus magit-buffer-upstream)
(width (if magit-refs-show-commit-count
magit-refs-focus-column-width
1)))
(format
(format "%%%ss " width)
(cond ((or (equal ref focus)
(and (eq type t)
(equal focus "HEAD")))
(magit--propertize-face (concat (if (equal focus "HEAD") "@" "*")
(make-string (1- width) ?\s))
'magit-section-heading))
((if (eq type 'tag)
(eq magit-refs-show-commit-count 'all)
magit-refs-show-commit-count)
(pcase-let ((`(,behind ,ahead)
(magit-rev-diff-count magit-buffer-upstream ref)))
(magit--propertize-face
(cond ((> ahead 0) (concat "<" (number-to-string ahead)))
((> behind 0) (concat (number-to-string behind) ">"))
(t "="))
'magit-dimmed)))
(t "")))))
(defun magit-refs--propertize-branch (branch ref &optional head-face)
(let ((face (cdr (cl-find-if (pcase-lambda (`(,re . ,_))
(string-match-p re ref))
magit-ref-namespaces))))
(magit--propertize-face
branch (if head-face (list face head-face) face))))
(defun magit-refs--insert-refname-p (refname)
(--if-let (-first (pcase-lambda (`(,key . ,_))
(if (functionp key)
(funcall key refname)
(string-match-p key refname)))
magit-refs-filter-alist)
(cdr it)
t))
(defun magit-refs--insert-cherry-commits (ref)
(magit-insert-section-body
(let ((start (point))
(magit-insert-section--current nil))
(magit-git-wash (apply-partially #'magit-log-wash-log 'cherry)
"cherry" "-v" (magit-abbrev-arg) magit-buffer-upstream ref)
(if (= (point) start)
(message "No cherries for %s" ref)
(magit-make-margin-overlay nil t)))))
(defun magit-refs--format-margin (commit)
(save-excursion
(goto-char (line-beginning-position 0))
(let ((line (magit-rev-format "%ct%cN" commit)))
(magit-log-format-margin commit
(substring line 10)
(substring line 0 10)))))
;;; _
(provide 'magit-refs)
;;; magit-refs.el ends here

368
code/elpa/magit-20220425.1153/magit-remote.el Normal file
View file

@ -0,0 +1,368 @@
;;; magit-remote.el --- Transfer Git commits -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library implements remote commands.
;;; Code:
(require 'magit)
;;; Options
(defcustom magit-remote-add-set-remote.pushDefault 'ask-if-unset
"Whether to set the value of `remote.pushDefault' after adding a remote.
If `ask', then always ask. If `ask-if-unset', then ask, but only
if the variable isn't set already. If nil, then don't ever set.
If the value is a string, then set without asking, provided that
the name of the added remote is equal to that string and the
variable isn't already set."
:package-version '(magit . "2.4.0")
:group 'magit-commands
:type '(choice (const :tag "ask if unset" ask-if-unset)
(const :tag "always ask" ask)
(string :tag "set if named")
(const :tag "don't set")))
(defcustom magit-remote-direct-configure t
"Whether the command `magit-remote' shows Git variables.
When set to nil, no variables are displayed by this transient
command, instead the sub-transient `magit-remote-configure'
has to be used to view and change remote related variables."
:package-version '(magit . "2.12.0")
:group 'magit-commands
:type 'boolean)
(defcustom magit-prefer-push-default nil
"Whether to prefer `remote.pushDefault' over per-branch variables."
:package-version '(magit . "3.0.0")
:group 'magit-commands
:type 'boolean)
;;; Commands
;;;###autoload (autoload 'magit-remote "magit-remote" nil t)
(transient-define-prefix magit-remote (remote)
"Add, configure or remove a remote."
:man-page "git-remote"
:value '("-f")
["Variables"
:if (lambda ()
(and magit-remote-direct-configure
(oref transient--prefix scope)))
("u" magit-remote.<remote>.url)
("U" magit-remote.<remote>.fetch)
("s" magit-remote.<remote>.pushurl)
("S" magit-remote.<remote>.push)
("O" magit-remote.<remote>.tagopt)]
["Arguments for add"
("-f" "Fetch after add" "-f")]
["Actions"
[("a" "Add" magit-remote-add)
("r" "Rename" magit-remote-rename)
("k" "Remove" magit-remote-remove)]
[("C" "Configure..." magit-remote-configure)
("p" "Prune stale branches" magit-remote-prune)
("P" "Prune stale refspecs" magit-remote-prune-refspecs)
(7 "z" "Unshallow remote" magit-remote-unshallow)]]
(interactive (list (magit-get-current-remote)))
(transient-setup 'magit-remote nil nil :scope remote))
(defun magit-read-url (prompt &optional initial-input)
(let ((url (magit-read-string-ns prompt initial-input)))
(if (string-prefix-p "~" url)
(expand-file-name url)
url)))
;;;###autoload
(defun magit-remote-add (remote url &optional args)
"Add a remote named REMOTE and fetch it."
(interactive
(let ((origin (magit-get "remote.origin.url"))
(remote (magit-read-string-ns "Remote name")))
(list remote
(magit-read-url
"Remote url"
(and origin
(string-match "\\([^:/]+\\)/[^/]+\\(\\.git\\)?\\'" origin)
(replace-match remote t t origin 1)))
(transient-args 'magit-remote))))
(if (pcase (list magit-remote-add-set-remote.pushDefault
(magit-get "remote.pushDefault"))
(`(,(pred stringp) ,_) t)
((or `(ask ,_) '(ask-if-unset nil))
(y-or-n-p (format "Set `remote.pushDefault' to \"%s\"? " remote))))
(progn (magit-call-git "remote" "add" args remote url)
(setf (magit-get "remote.pushDefault") remote)
(magit-refresh))
(magit-run-git-async "remote" "add" args remote url)))
;;;###autoload
(defun magit-remote-rename (old new)
"Rename the remote named OLD to NEW."
(interactive
(let ((remote (magit-read-remote "Rename remote")))
(list remote (magit-read-string-ns (format "Rename %s to" remote)))))
(unless (string= old new)
(magit-call-git "remote" "rename" old new)
(magit-remote--cleanup-push-variables old new)
(magit-refresh)))
;;;###autoload
(defun magit-remote-remove (remote)
"Delete the remote named REMOTE."
(interactive (list (magit-read-remote "Delete remote")))
(magit-call-git "remote" "rm" remote)
(magit-remote--cleanup-push-variables remote)
(magit-refresh))
(defun magit-remote--cleanup-push-variables (remote &optional new-name)
(magit-with-toplevel
(when (equal (magit-get "remote.pushDefault") remote)
(magit-set new-name "remote.pushDefault"))
(dolist (var (magit-git-lines "config" "--name-only"
"--get-regexp" "^branch\.[^.]*\.pushRemote"
(format "^%s$" remote)))
(magit-call-git "config" (and (not new-name) "--unset") var new-name))))
(defconst magit--refspec-re "\\`\\(\\+\\)?\\([^:]+\\):\\(.*\\)\\'")
;;;###autoload
(defun magit-remote-prune (remote)
"Remove stale remote-tracking branches for REMOTE."
(interactive (list (magit-read-remote "Prune stale branches of remote")))
(magit-run-git-async "remote" "prune" remote))
;;;###autoload
(defun magit-remote-prune-refspecs (remote)
"Remove stale refspecs for REMOTE.
A refspec is stale if there no longer exists at least one branch
on the remote that would be fetched due to that refspec. A stale
refspec is problematic because its existence causes Git to refuse
to fetch according to the remaining non-stale refspecs.
If only stale refspecs remain, then offer to either delete the
remote or to replace the stale refspecs with the default refspec.
Also remove the remote-tracking branches that were created due to
the now stale refspecs. Other stale branches are not removed."
(interactive (list (magit-read-remote "Prune refspecs of remote")))
(let* ((tracking-refs (magit-list-remote-branches remote))
(remote-refs (magit-remote-list-refs remote))
(variable (format "remote.%s.fetch" remote))
(refspecs (magit-get-all variable))
stale)
(dolist (refspec refspecs)
(when (string-match magit--refspec-re refspec)
(let ((theirs (match-string 2 refspec))
(ours (match-string 3 refspec)))
(unless (if (string-match "\\*" theirs)
(let ((re (replace-match ".*" t t theirs)))
(--some (string-match-p re it) remote-refs))
(member theirs remote-refs))
(push (cons refspec
(if (string-match "\\*" ours)
(let ((re (replace-match ".*" t t ours)))
(--filter (string-match-p re it) tracking-refs))
(list (car (member ours tracking-refs)))))
stale)))))
(if (not stale)
(message "No stale refspecs for remote %S" remote)
(if (= (length stale)
(length refspecs))
(magit-read-char-case
(format "All of %s's refspecs are stale. " remote) nil
(?s "replace with [d]efault refspec"
(magit-set-all
(list (format "+refs/heads/*:refs/remotes/%s/*" remote))
variable))
(?r "[r]emove remote"
(magit-call-git "remote" "rm" remote))
(?a "or [a]abort"
(user-error "Abort")))
(if (if (length= stale 1)
(pcase-let ((`(,refspec . ,refs) (car stale)))
(magit-confirm 'prune-stale-refspecs
(format "Prune stale refspec %s and branch %%s" refspec)
(format "Prune stale refspec %s and %%i branches" refspec)
nil refs))
(magit-confirm 'prune-stale-refspecs nil
(format "Prune %%i stale refspecs and %i branches"
(length (cl-mapcan (lambda (s) (copy-sequence (cdr s)))
stale)))
nil
(mapcar (pcase-lambda (`(,refspec . ,refs))
(concat refspec "\n"
(mapconcat (lambda (b) (concat " " b))
refs "\n")))
stale)))
(pcase-dolist (`(,refspec . ,refs) stale)
(magit-call-git "config" "--unset" variable
(regexp-quote refspec))
(magit--log-action
(lambda (refs)
(format "Deleting %i branches" (length refs)))
(lambda (ref)
(format "Deleting branch %s (was %s)" ref
(magit-rev-parse "--short" ref)))
refs)
(dolist (ref refs)
(magit-call-git "update-ref" "-d" ref)))
(user-error "Abort")))
(magit-refresh))))
;;;###autoload
(defun magit-remote-set-head (remote &optional branch)
"Set the local representation of REMOTE's default branch.
Query REMOTE and set the symbolic-ref refs/remotes/<remote>/HEAD
accordingly. With a prefix argument query for the branch to be
used, which allows you to select an incorrect value if you fancy
doing that."
(interactive
(let ((remote (magit-read-remote "Set HEAD for remote")))
(list remote
(and current-prefix-arg
(magit-read-remote-branch (format "Set %s/HEAD to" remote)
remote nil nil t)))))
(magit-run-git "remote" "set-head" remote (or branch "--auto")))
;;;###autoload
(defun magit-remote-unset-head (remote)
"Unset the local representation of REMOTE's default branch.
Delete the symbolic-ref \"refs/remotes/<remote>/HEAD\"."
(interactive (list (magit-read-remote "Unset HEAD for remote")))
(magit-run-git "remote" "set-head" remote "--delete"))
;;;###autoload
(defun magit-remote-unshallow (remote)
"Convert a shallow remote into a full one.
If only a single refspec is set and it does not contain a
wildcard, then also offer to replace it with the standard
refspec."
(interactive (list (or (magit-get-current-remote)
(magit-read-remote "Delete remote"))))
(let ((refspecs (magit-get-all "remote" remote "fetch"))
(standard (format "+refs/heads/*:refs/remotes/%s/*" remote)))
(when (and (length= refspecs 1)
(not (string-search "*" (car refspecs)))
(yes-or-no-p (format "Also replace refspec %s with %s? "
(car refspecs)
standard)))
(magit-set standard "remote" remote "fetch"))
(magit-git-fetch "--unshallow" remote)))
;;; Configure
;;;###autoload (autoload 'magit-remote-configure "magit-remote" nil t)
(transient-define-prefix magit-remote-configure (remote)
"Configure a remote."
:man-page "git-remote"
[:description
(lambda ()
(concat
(propertize "Configure " 'face 'transient-heading)
(propertize (oref transient--prefix scope) 'face 'magit-branch-remote)))
("u" magit-remote.<remote>.url)
("U" magit-remote.<remote>.fetch)
("s" magit-remote.<remote>.pushurl)
("S" magit-remote.<remote>.push)
("O" magit-remote.<remote>.tagopt)]
(interactive
(list (or (and (not current-prefix-arg)
(not (and magit-remote-direct-configure
(eq transient-current-command 'magit-remote)))
(magit-get-current-remote))
(magit--read-remote-scope))))
(transient-setup 'magit-remote-configure nil nil :scope remote))
(defun magit--read-remote-scope (&optional obj)
(magit-read-remote
(if obj
(format "Set %s for remote"
(format (oref obj variable) "<name>"))
"Configure remote")))
(transient-define-infix magit-remote.<remote>.url ()
:class 'magit--git-variable:urls
:scope #'magit--read-remote-scope
:variable "remote.%s.url"
:multi-value t
:history-key 'magit-remote.<remote>.*url)
(transient-define-infix magit-remote.<remote>.fetch ()
:class 'magit--git-variable
:scope #'magit--read-remote-scope
:variable "remote.%s.fetch"
:multi-value t)
(transient-define-infix magit-remote.<remote>.pushurl ()
:class 'magit--git-variable:urls
:scope #'magit--read-remote-scope
:variable "remote.%s.pushurl"
:multi-value t
:history-key 'magit-remote.<remote>.*url
:seturl-arg "--push")
(transient-define-infix magit-remote.<remote>.push ()
:class 'magit--git-variable
:scope #'magit--read-remote-scope
:variable "remote.%s.push")
(transient-define-infix magit-remote.<remote>.tagopt ()
:class 'magit--git-variable:choices
:scope #'magit--read-remote-scope
:variable "remote.%s.tagOpt"
:choices '("--no-tags" "--tags"))
;;; Transfer Utilities
(defun magit--push-remote-variable (&optional branch short)
(unless branch
(setq branch (magit-get-current-branch)))
(magit--propertize-face
(if (or (not branch) magit-prefer-push-default)
(if short "pushDefault" "remote.pushDefault")
(if short "pushRemote" (format "branch.%s.pushRemote" branch)))
'bold))
(defun magit--select-push-remote (prompt-suffix)
(let* ((branch (or (magit-get-current-branch)
(user-error "No branch is checked out")))
(remote (magit-get-push-remote branch))
(changed nil))
(when (or current-prefix-arg
(not remote)
(not (member remote (magit-list-remotes))))
(setq changed t)
(setq remote
(magit-read-remote (format "Set %s and %s"
(magit--push-remote-variable)
prompt-suffix)))
(setf (magit-get (magit--push-remote-variable branch)) remote))
(list branch remote changed)))
;;; _
(provide 'magit-remote)
;;; magit-remote.el ends here

543
code/elpa/magit-20220425.1153/magit-repos.el Normal file
View file

@ -0,0 +1,543 @@
;;; magit-repos.el --- Listing repositories -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library implements support for listing repositories. This
;; includes getting a Lisp list of known repositories as well as a
;; mode for listing repositories in a buffer.
;;; Code:
(require 'magit-core)
(declare-function magit-status-setup-buffer "magit-status" (&optional directory))
(defvar x-stretch-cursor)
;;; Options
(defcustom magit-repository-directories nil
"List of directories that are or contain Git repositories.
Each element has the form (DIRECTORY . DEPTH). DIRECTORY has
to be a directory or a directory file-name, a string. DEPTH,
an integer, specifies the maximum depth to look for Git
repositories. If it is 0, then only add DIRECTORY itself.
This option controls which repositories are being listed by
`magit-list-repositories'. It also affects `magit-status'
\(which see) in potentially surprising ways."
:package-version '(magit . "3.0.0")
:group 'magit-essentials
:type '(repeat (cons directory (integer :tag "Depth"))))
(defgroup magit-repolist nil
"List repositories in a buffer."
:link '(info-link "(magit)Repository List")
:group 'magit-modes)
(defcustom magit-repolist-mode-hook '(hl-line-mode)
"Hook run after entering Magit-Repolist mode."
:package-version '(magit . "2.9.0")
:group 'magit-repolist
:type 'hook
:get #'magit-hook-custom-get
:options '(hl-line-mode))
(defcustom magit-repolist-columns
'(("Name" 25 magit-repolist-column-ident nil)
("Version" 25 magit-repolist-column-version
((:sort magit-repolist-version<)))
("B<U" 3 magit-repolist-column-unpulled-from-upstream
(;; (:help-echo "Upstream changes not in branch")
(:right-align t)
(:sort <)))
("B>U" 3 magit-repolist-column-unpushed-to-upstream
(;; (:help-echo "Local changes not in upstream")
(:right-align t)
(:sort <)))
("Path" 99 magit-repolist-column-path nil))
"List of columns displayed by `magit-list-repositories'.
Each element has the form (HEADER WIDTH FORMAT PROPS).
HEADER is the string displayed in the header. WIDTH is the width
of the column. FORMAT is a function that is called with one
argument, the repository identification (usually its basename),
and with `default-directory' bound to the toplevel of its working
tree. It has to return a string to be inserted or nil. PROPS is
an alist that supports the keys `:right-align', `:pad-right' and
`:sort'.
The `:sort' function has a weird interface described in the
docstring of `tabulated-list--get-sort'. Alternatively `<' and
`magit-repolist-version<' can be used as those functions are
automatically replaced with functions that satisfy the interface.
Set `:sort' to nil to inhibit sorting; if unspecifed, then the
column is sortable using the default sorter.
You may wish to display a range of numeric columns using just one
character per column and without any padding between columns, in
which case you should use an appropriat HEADER, set WIDTH to 1,
and set `:pad-right' to 0. \"+\" is substituted for numbers higher
than 9."
:package-version '(magit . "2.12.0")
:group 'magit-repolist
:type '(repeat (list :tag "Column"
(string :tag "Header Label")
(integer :tag "Column Width")
(function :tag "Inserter Function")
(repeat :tag "Properties"
(list (choice :tag "Property"
(const :right-align)
(const :pad-right)
(const :sort)
(symbol))
(sexp :tag "Value"))))))
(defcustom magit-repolist-column-flag-alist
'((magit-untracked-files . "N")
(magit-unstaged-files . "U")
(magit-staged-files . "S"))
"Association list of predicates and flags for `magit-repolist-column-flag'.
Each element is of the form (FUNCTION . FLAG). Each FUNCTION is
called with no arguments, with `default-directory' bound to the
top level of a repository working tree, until one of them returns
a non-nil value. FLAG corresponding to that function is returned
as the value of `magit-repolist-column-flag'."
:package-version '(magit . "3.0.0")
:group 'magit-repolist
:type '(alist :key-type (function :tag "Predicate Function")
:value-type (string :tag "Flag")))
(defcustom magit-repolist-sort-key '("Path" . nil)
"Initial sort key for buffer created by `magit-list-repositories'.
If nil, no additional sorting is performed. Otherwise, this
should be a cons cell (NAME . FLIP). NAME is a string matching
one of the column names in `magit-repolist-columns'. FLIP, if
non-nil, means to invert the resulting sort."
:package-version '(magit . "3.2.0")
:group 'magit-repolist
:type '(choice (const nil)
(cons (string :tag "Column name")
(boolean :tag "Flip order"))))
;;; List Repositories
;;;; List Commands
;;;###autoload
(defun magit-list-repositories ()
"Display a list of repositories.
Use the options `magit-repository-directories' to control which
repositories are displayed."
(interactive)
(magit-repolist-setup (default-value 'magit-repolist-columns)))
;;;; Mode Commands
(defun magit-repolist-status (&optional _button)
"Show the status for the repository at point."
(interactive)
(--if-let (tabulated-list-get-id)
(magit-status-setup-buffer (expand-file-name it))
(user-error "There is no repository at point")))
(defun magit-repolist-mark ()
"Mark a repository and move to the next line."
(interactive)
(magit-repolist--ensure-padding)
(tabulated-list-put-tag "*" t))
(defun magit-repolist-unmark ()
"Unmark a repository and move to the next line."
(interactive)
(tabulated-list-put-tag " " t))
(defun magit-repolist-fetch (repos)
"Fetch all marked or listed repositories."
(interactive (list (magit-repolist--get-repos ?*)))
(run-hooks 'magit-credential-hook)
(magit-repolist--mapc (apply-partially #'magit-run-git "remote" "update")
repos "Fetching in %s..."))
(defun magit-repolist-find-file-other-frame (repos file)
"Find a file in all marked or listed repositories."
(interactive (list (magit-repolist--get-repos ?*)
(read-string "Find file in repositories: ")))
(magit-repolist--mapc (apply-partially #'find-file-other-frame file) repos))
(defun magit-repolist--ensure-padding ()
"Set `tabulated-list-padding' to 2, unless that is already non-zero."
(when (zerop tabulated-list-padding)
(setq tabulated-list-padding 2)
(tabulated-list-init-header)
(tabulated-list-print t)))
(defun magit-repolist--get-repos (&optional char)
"Return marked repositories or `all' if none are marked.
If optional CHAR is non-nil, then only return repositories
marked with that character. If no repositories are marked
then ask whether to act on all repositories instead."
(or (magit-repolist--marked-repos char)
(if (magit-confirm 'repolist-all
"Nothing selected. Act on ALL displayed repositories")
'all
(user-error "Abort"))))
(defun magit-repolist--marked-repos (&optional char)
"Return marked repositories.
If optional CHAR is non-nil, then only return repositories
marked with that character."
(let (c list)
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(setq c (char-after))
(unless (eq c ?\s)
(if char
(when (eq c char)
(push (tabulated-list-get-id) list))
(push (cons c (tabulated-list-get-id)) list)))
(forward-line)))
list))
(defun magit-repolist--mapc (fn repos &optional msg)
"Apply FN to each directory in REPOS for side effects only.
If REPOS is the symbol `all', then call FN for all displayed
repositories. When FN is called, `default-directory' is bound to
the top-level directory of the current repository. If optional
MSG is non-nil then that is displayed around each call to FN.
If it contains \"%s\" then the directory is substituted for that."
(when (eq repos 'all)
(setq repos nil)
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(push (tabulated-list-get-id) repos)
(forward-line)))
(setq repos (nreverse repos)))
(let ((base default-directory)
(len (length repos))
(i 0))
(mapc (lambda (repo)
(let ((default-directory
(file-name-as-directory (expand-file-name repo base))))
(if msg
(let ((msg (concat (format "(%s/%s) " (cl-incf i) len)
(format msg default-directory))))
(message msg)
(funcall fn)
(message (concat msg "done")))
(funcall fn))))
repos)))
;;;; Mode
(defvar magit-repolist-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map tabulated-list-mode-map)
(define-key map (kbd "C-m") #'magit-repolist-status)
(define-key map (kbd "m") #'magit-repolist-mark)
(define-key map (kbd "u") #'magit-repolist-unmark)
(define-key map (kbd "f") #'magit-repolist-fetch)
(define-key map (kbd "5") #'magit-repolist-find-file-other-frame)
map)
"Local keymap for Magit-Repolist mode buffers.")
(define-derived-mode magit-repolist-mode tabulated-list-mode "Repos"
"Major mode for browsing a list of Git repositories."
(setq-local x-stretch-cursor nil)
(setq tabulated-list-padding 0)
(add-hook 'tabulated-list-revert-hook #'magit-repolist-refresh nil t)
(setq imenu-prev-index-position-function
#'magit-repolist--imenu-prev-index-position)
(setq imenu-extract-index-name-function #'tabulated-list-get-id))
(defun magit-repolist-setup (columns)
(unless magit-repository-directories
(user-error "You need to customize `magit-repository-directories' %s"
"before you can list repositories"))
(with-current-buffer (get-buffer-create "*Magit Repositories*")
(magit-repolist-mode)
(setq-local magit-repolist-columns columns)
(magit-repolist-setup-1)
(magit-repolist-refresh)
(switch-to-buffer (current-buffer))))
(defun magit-repolist-setup-1 ()
(unless tabulated-list-sort-key
(setq tabulated-list-sort-key
(pcase-let ((`(,column . ,flip) magit-repolist-sort-key))
(cons (or (car (assoc column magit-repolist-columns))
(caar magit-repolist-columns))
flip))))
(setq tabulated-list-format
(vconcat (-map-indexed
(lambda (idx column)
(pcase-let* ((`(,title ,width ,_fn ,props) column)
(sort-set (assoc :sort props))
(sort-fn (cadr sort-set)))
(nconc (list title width
(cond ((eq sort-fn '<)
(magit-repolist-make-sorter
sort-fn #'string-to-number idx))
((eq sort-fn 'magit-repolist-version<)
(magit-repolist-make-sorter
sort-fn #'identity idx))
(sort-fn sort-fn)
(sort-set nil)
(t t)))
(-flatten props))))
magit-repolist-columns))))
(defun magit-repolist-refresh ()
(setq tabulated-list-entries
(mapcar (pcase-lambda (`(,id . ,path))
(let ((default-directory path))
(list path
(vconcat
(mapcar (pcase-lambda (`(,title ,width ,fn ,props))
(or (funcall fn `((:id ,id)
(:title ,title)
(:width ,width)
,@props))
""))
magit-repolist-columns)))))
(magit-list-repos-uniquify
(--map (cons (file-name-nondirectory (directory-file-name it))
it)
(magit-list-repos)))))
(message "Listing repositories...")
(tabulated-list-init-header)
(tabulated-list-print t)
(message "Listing repositories...done"))
(defun magit-repolist--imenu-prev-index-position ()
(and (not (bobp))
(forward-line -1)))
;;;; Columns
(defun magit-repolist-make-sorter (sort-predicate convert-cell column-idx)
"Return a function suitable as a sorter for tabulated lists.
See `tabulated-list--get-sorter'. Given a more reasonable API
this would not be necessary and one could just use SORT-PREDICATE
directly. CONVERT-CELL can be used to turn the cell value, which
is always a string back into e.g. a number. COLUMN-IDX has to be
the index of the column that uses the returned sorter function."
(lambda (a b)
(funcall sort-predicate
(funcall convert-cell (aref (cadr a) column-idx))
(funcall convert-cell (aref (cadr b) column-idx)))))
(defun magit-repolist-column-ident (spec)
"Insert the identification of the repository.
Usually this is just its basename."
(cadr (assq :id spec)))
(defun magit-repolist-column-path (_)
"Insert the absolute path of the repository."
(abbreviate-file-name default-directory))
(defvar magit-repolist-column-version-regexp "\
\\(?1:-\\(?2:[0-9]*\\)\
\\(?3:-g[a-z0-9]*\\)\\)?\
\\(?:-\\(?4:dirty\\)\\)\
?\\'")
(defvar magit-repolist-column-version-resume-regexp
"\\`Resume development\\'")
(defun magit-repolist-column-version (_)
"Insert a description of the repository's `HEAD' revision."
(and-let* ((v (or (magit-git-string "describe" "--tags" "--dirty")
;; If there are no tags, use the date in MELPA format.
(magit-git-string "show" "--no-patch" "--format=%cd-g%h"
"--date=format:%Y%m%d.%H%M"))))
(save-match-data
(when (string-match magit-repolist-column-version-regexp v)
(magit--put-face (match-beginning 0) (match-end 0) 'shadow v)
(when (match-end 2)
(magit--put-face (match-beginning 2) (match-end 2) 'bold v))
(when (match-end 4)
(magit--put-face (match-beginning 4) (match-end 4) 'error v))
(when (and (equal (match-string 2 v) "1")
(string-match-p magit-repolist-column-version-resume-regexp
(magit-rev-format "%s")))
(setq v (replace-match (propertize "+" 'face 'shadow) t t v 1))))
(if (and v (string-match "\\`[0-9]" v))
(concat " " v)
(when (and v (string-match "\\`[^0-9]+" v))
(magit--put-face 0 (match-end 0) 'shadow v))
v))))
(defun magit-repolist-version< (a b)
(save-match-data
(let ((re "[0-9]+\\(\\.[0-9]*\\)*"))
(setq a (and (string-match re a) (match-string 0 a)))
(setq b (and (string-match re b) (match-string 0 b)))
(cond ((and a b) (version< a b))
(b nil)
(t t)))))
(defun magit-repolist-column-branch (_)
"Insert the current branch."
(let ((branch (magit-get-current-branch)))
(if (member branch magit-main-branch-names)
(magit--propertize-face branch 'shadow)
branch)))
(defun magit-repolist-column-upstream (_)
"Insert the upstream branch of the current branch."
(magit-get-upstream-branch))
(defun magit-repolist-column-flag (_)
"Insert a flag as specified by `magit-repolist-column-flag-alist'.
By default this indicates whether there are uncommitted changes.
- N if there is at least one untracked file.
- U if there is at least one unstaged file.
- S if there is at least one staged file.
Only one letter is shown, the first that applies."
(seq-some (pcase-lambda (`(,fun . ,flag))
(and (funcall fun) flag))
magit-repolist-column-flag-alist))
(defun magit-repolist-column-flags (_)
"Insert all flags as specified by `magit-repolist-column-flag-alist'.
This is an alternative to function `magit-repolist-column-flag',
which only lists the first one found."
(mapconcat (pcase-lambda (`(,fun . ,flag))
(if (funcall fun) flag " "))
magit-repolist-column-flag-alist
""))
(defun magit-repolist-column-unpulled-from-upstream (spec)
"Insert number of upstream commits not in the current branch."
(and-let* ((br (magit-get-upstream-branch)))
(magit-repolist-insert-count (cadr (magit-rev-diff-count "HEAD" br)) spec)))
(defun magit-repolist-column-unpulled-from-pushremote (spec)
"Insert number of commits in the push branch but not the current branch."
(and-let* ((br (magit-get-push-branch nil t)))
(magit-repolist-insert-count (cadr (magit-rev-diff-count "HEAD" br)) spec)))
(defun magit-repolist-column-unpushed-to-upstream (spec)
"Insert number of commits in the current branch but not its upstream."
(and-let* ((br (magit-get-upstream-branch)))
(magit-repolist-insert-count (car (magit-rev-diff-count "HEAD" br)) spec)))
(defun magit-repolist-column-unpushed-to-pushremote (spec)
"Insert number of commits in the current branch but not its push branch."
(and-let* ((br (magit-get-push-branch nil t)))
(magit-repolist-insert-count (car (magit-rev-diff-count "HEAD" br)) spec)))
(defun magit-repolist-column-branches (spec)
"Insert number of branches."
(magit-repolist-insert-count (length (magit-list-local-branches))
`((:normal-count 1) ,@spec)))
(defun magit-repolist-column-stashes (spec)
"Insert number of stashes."
(magit-repolist-insert-count (length (magit-list-stashes)) spec))
(defun magit-repolist-insert-count (n spec)
(magit--propertize-face
(if (and (> n 9) (= (cadr (assq :width spec)) 1))
"+"
(number-to-string n))
(if (> n (or (cadr (assq :normal-count spec)) 0)) 'bold 'shadow)))
;;; Read Repository
(defun magit-read-repository (&optional read-directory-name)
"Read a Git repository in the minibuffer, with completion.
The completion choices are the basenames of top-levels of
repositories found in the directories specified by option
`magit-repository-directories'. In case of name conflicts
the basenames are prefixed with the name of the respective
parent directories. The returned value is the actual path
to the selected repository.
If READ-DIRECTORY-NAME is non-nil or no repositories can be
found based on the value of `magit-repository-directories',
then read an arbitrary directory using `read-directory-name'
instead."
(if-let ((repos (and (not read-directory-name)
magit-repository-directories
(magit-repos-alist))))
(let ((reply (magit-completing-read "Git repository" repos)))
(file-name-as-directory
(or (cdr (assoc reply repos))
(if (file-directory-p reply)
(expand-file-name reply)
(user-error "Not a repository or a directory: %s" reply)))))
(file-name-as-directory
(read-directory-name "Git repository: "
(or (magit-toplevel) default-directory)))))
(defun magit-list-repos ()
(cl-mapcan (pcase-lambda (`(,dir . ,depth))
(magit-list-repos-1 dir depth))
magit-repository-directories))
(defun magit-list-repos-1 (directory depth)
(cond ((file-readable-p (expand-file-name ".git" directory))
(list (file-name-as-directory directory)))
((and (> depth 0) (magit-file-accessible-directory-p directory))
(--mapcat (and (file-directory-p it)
(magit-list-repos-1 it (1- depth)))
(directory-files directory t
directory-files-no-dot-files-regexp t)))))
(defun magit-list-repos-uniquify (alist)
(let (result (dict (make-hash-table :test #'equal)))
(dolist (a (delete-dups alist))
(puthash (car a) (cons (cdr a) (gethash (car a) dict)) dict))
(maphash
(lambda (key value)
(if (length= value 1)
(push (cons key (car value)) result)
(setq result
(append result
(magit-list-repos-uniquify
(--map (cons (concat
key "\\"
(file-name-nondirectory
(directory-file-name
(substring it 0 (- (1+ (length key)))))))
it)
value))))))
dict)
result))
(defun magit-repos-alist ()
(magit-list-repos-uniquify
(--map (cons (file-name-nondirectory (directory-file-name it)) it)
(magit-list-repos))))
;;; _
(provide 'magit-repos)
;;; magit-repos.el ends here

134
code/elpa/magit-20220425.1153/magit-reset.el Normal file
View file

@ -0,0 +1,134 @@
;;; magit-reset.el --- Reset fuctionality -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library implements reset commands.
;;; Code:
(require 'magit)
;;;###autoload (autoload 'magit-reset "magit" nil t)
(transient-define-prefix magit-reset ()
"Reset the `HEAD', index and/or worktree to a previous state."
:man-page "git-reset"
["Reset"
("m" "mixed (HEAD and index)" magit-reset-mixed)
("s" "soft (HEAD only)" magit-reset-soft)
("h" "hard (HEAD, index and files)" magit-reset-hard)
("k" "keep (HEAD and index, keeping uncommitted)" magit-reset-keep)
("i" "index (only)" magit-reset-index)
("w" "worktree (only)" magit-reset-worktree)
""
("f" "a file" magit-file-checkout)])
;;;###autoload
(defun magit-reset-mixed (commit)
"Reset the `HEAD' and index to COMMIT, but not the working tree.
\n(git reset --mixed COMMIT)"
(interactive (list (magit-reset-read-branch-or-commit "Reset %s to")))
(magit-reset-internal "--mixed" commit))
;;;###autoload
(defun magit-reset-soft (commit)
"Reset the `HEAD' to COMMIT, but not the index and working tree.
\n(git reset --soft REVISION)"
(interactive (list (magit-reset-read-branch-or-commit "Soft reset %s to")))
(magit-reset-internal "--soft" commit))
;;;###autoload
(defun magit-reset-hard (commit)
"Reset the `HEAD', index, and working tree to COMMIT.
\n(git reset --hard REVISION)"
(interactive (list (magit-reset-read-branch-or-commit
(concat (magit--propertize-face "Hard" 'bold)
" reset %s to"))))
(magit-reset-internal "--hard" commit))
;;;###autoload
(defun magit-reset-keep (commit)
"Reset the `HEAD' and index to COMMIT, while keeping uncommitted changes.
\n(git reset --keep REVISION)"
(interactive (list (magit-reset-read-branch-or-commit "Reset %s to")))
(magit-reset-internal "--keep" commit))
;;;###autoload
(defun magit-reset-index (commit)
"Reset the index to COMMIT.
Keep the `HEAD' and working tree as-is, so if COMMIT refers to the
head this effectively unstages all changes.
\n(git reset COMMIT .)"
(interactive (list (magit-read-branch-or-commit "Reset index to")))
(magit-reset-internal nil commit "."))
;;;###autoload
(defun magit-reset-worktree (commit)
"Reset the worktree to COMMIT.
Keep the `HEAD' and index as-is."
(interactive (list (magit-read-branch-or-commit "Reset worktree to")))
(magit-wip-commit-before-change nil " before reset")
(magit-with-temp-index commit nil
(magit-call-git "checkout-index" "--all" "--force"))
(magit-wip-commit-after-apply nil " after reset")
(magit-refresh))
;;;###autoload
(defun magit-reset-quickly (commit &optional hard)
"Reset the `HEAD' and index to COMMIT, and possibly the working tree.
With a prefix argument reset the working tree otherwise don't.
\n(git reset --mixed|--hard COMMIT)"
(interactive (list (magit-reset-read-branch-or-commit
(if current-prefix-arg
(concat (magit--propertize-face "Hard" 'bold)
" reset %s to")
"Reset %s to"))
current-prefix-arg))
(magit-reset-internal (if hard "--hard" "--mixed") commit))
(defun magit-reset-read-branch-or-commit (prompt)
"Prompt for and return a ref to reset HEAD to.
PROMPT is a format string, where either the current branch name
or \"detached head\" will be substituted for %s."
(magit-read-branch-or-commit
(format prompt (or (magit-get-current-branch) "detached head"))))
(defun magit-reset-internal (arg commit &optional path)
(when (and (not (member arg '("--hard" nil)))
(equal (magit-rev-parse commit)
(magit-rev-parse "HEAD~")))
(with-temp-buffer
(magit-git-insert "show" "-s" "--format=%B" "HEAD")
(when git-commit-major-mode
(funcall git-commit-major-mode))
(git-commit-setup-font-lock)
(git-commit-save-message)))
(let ((cmd (if (and (equal commit "HEAD") (not arg)) "unstage" "reset")))
(magit-wip-commit-before-change nil (concat " before " cmd))
(magit-run-git "reset" arg commit "--" path)
(when (equal cmd "unstage")
(magit-wip-commit-after-apply nil " after unstage"))))
;;; _
(provide 'magit-reset)
;;; magit-reset.el ends here

1087
code/elpa/magit-20220425.1153/magit-sequence.el Normal file
View file

File diff suppressed because it is too large Load diff

170
code/elpa/magit-20220425.1153/magit-sparse-checkout.el Normal file
View file

@ -0,0 +1,170 @@
;;; magit-sparse-checkout.el --- Sparse checkout support for Magit -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Kyle Meyer <kyle@kyleam.com>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library provides an interface to the `git sparse-checkout'
;; command. It's been possible to define sparse checkouts since Git
;; v1.7.0 by adding patterns to $GIT_DIR/info/sparse-checkout and
;; calling `git read-tree -mu HEAD' to update the index and working
;; tree. However, Git v2.25 introduced the `git sparse-checkout'
;; command along with "cone mode", which restricts the possible
;; patterns to directories to provide better performance.
;;
;; The goal of this library is to support the `git sparse-checkout'
;; command operating in cone mode.
;;; Code:
(require 'magit)
;;; Utilities
(defun magit-sparse-checkout-enabled-p ()
"Return non-nil if working tree is a sparse checkout."
(magit-get-boolean "core.sparsecheckout"))
(defun magit-sparse-checkout--assert-version ()
;; Older versions of Git have the ability to define sparse checkout
;; patterns in .git/info/sparse-checkout, but the sparse-checkout
;; command isn't available until 2.25.0.
(when (magit-git-version< "2.25.0")
(user-error "`git sparse-checkout' not available until Git v2.25")))
(defun magit-sparse-checkout--auto-enable ()
(if (magit-sparse-checkout-enabled-p)
(unless (magit-get-boolean "core.sparsecheckoutcone")
(user-error
"Magit's sparse checkout functionality requires cone mode"))
;; Note: Don't use `magit-sparse-checkout-enable' because it's
;; asynchronous.
(magit-run-git "sparse-checkout" "init" "--cone")))
(defun magit-sparse-checkout-directories ()
"Return directories that are recursively included in the sparse checkout.
See the `git sparse-checkout' manpage for details about
\"recursive\" versus \"parent\" directories in cone mode."
(and (magit-get-boolean "core.sparsecheckoutcone")
(mapcar #'file-name-as-directory
(magit-git-lines "sparse-checkout" "list"))))
;;; Commands
;;;###autoload (autoload 'magit-sparse-checkout "magit-sparse-checkout" nil t)
(transient-define-prefix magit-sparse-checkout ()
"Create and manage sparse checkouts."
:man-page "git-sparse-checkout"
["Arguments for enabling"
:if-not magit-sparse-checkout-enabled-p
("-i" "Use sparse index" "--sparse-index")]
["Actions"
[:if-not magit-sparse-checkout-enabled-p
("e" "Enable sparse checkout" magit-sparse-checkout-enable)]
[:if magit-sparse-checkout-enabled-p
("d" "Disable sparse checkout" magit-sparse-checkout-disable)
("r" "Reapply rules" magit-sparse-checkout-reapply)]
[("s" "Set directories" magit-sparse-checkout-set)
("a" "Add directories" magit-sparse-checkout-add)]])
;;;###autoload
(defun magit-sparse-checkout-enable (&optional args)
"Convert the working tree to a sparse checkout."
(interactive (list (transient-args 'magit-sparse-checkout)))
(magit-sparse-checkout--assert-version)
(magit-run-git-async "sparse-checkout" "init" "--cone" args))
;;;###autoload
(defun magit-sparse-checkout-set (directories)
"Restrict working tree to DIRECTORIES.
To extend rather than override the currently configured
directories, call `magit-sparse-checkout-add' instead."
(interactive
(list (magit-completing-read-multiple*
"Include these directories: "
;; Note: Given that the appeal of sparse checkouts is
;; dealing with very large trees, listing all subdirectories
;; may need to be reconsidered.
(magit-revision-directories "HEAD"))))
(magit-sparse-checkout--assert-version)
(magit-sparse-checkout--auto-enable)
(magit-run-git-async "sparse-checkout" "set" directories))
;;;###autoload
(defun magit-sparse-checkout-add (directories)
"Add DIRECTORIES to the working tree.
To override rather than extend the currently configured
directories, call `magit-sparse-checkout-set' instead."
(interactive
(list (magit-completing-read-multiple*
"Add these directories: "
;; Same performance note as in `magit-sparse-checkout-set',
;; but even more so given the additional processing.
(seq-remove
(let ((re (concat
"\\`"
(regexp-opt (magit-sparse-checkout-directories)))))
(lambda (d) (string-match-p re d)))
(magit-revision-directories "HEAD")))))
(magit-sparse-checkout--assert-version)
(magit-sparse-checkout--auto-enable)
(magit-run-git-async "sparse-checkout" "add" directories))
;;;###autoload
(defun magit-sparse-checkout-reapply ()
"Reapply the sparse checkout rules to the working tree.
Some operations such as merging or rebasing may need to check out
files that aren't included in the sparse checkout. Call this
command to reset to the sparse checkout state."
(interactive)
(magit-sparse-checkout--assert-version)
(magit-run-git-async "sparse-checkout" "reapply"))
;;;###autoload
(defun magit-sparse-checkout-disable ()
"Convert sparse checkout to full checkout.
Note that disabling the sparse checkout does not clear the
configured directories. Call `magit-sparse-checkout-enable' to
restore the previous sparse checkout."
(interactive)
(magit-sparse-checkout--assert-version)
(magit-run-git-async "sparse-checkout" "disable"))
;;; Miscellaneous
(defun magit-sparse-checkout-insert-header ()
"Insert header line with sparse checkout information.
This header is not inserted by default. To enable it, add it to
`magit-status-headers-hook'."
(when (magit-sparse-checkout-enabled-p)
(insert (propertize (format "%-10s" "Sparse! ")
'font-lock-face 'magit-section-heading))
(insert
(let ((dirs (magit-sparse-checkout-directories)))
(pcase (length dirs)
(0 "top-level directory")
(1 (car dirs))
(n (format "%d directories" n)))))
(insert ?\n)))
;;; _
(provide 'magit-sparse-checkout)
;;; magit-sparse-checkout.el ends here

566
code/elpa/magit-20220425.1153/magit-stash.el Normal file
View file

@ -0,0 +1,566 @@
;;; magit-stash.el --- Stash support for Magit -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Support for Git stashes.
;;; Code:
(require 'magit)
(require 'magit-reflog)
(require 'magit-sequence)
;;; Options
(defgroup magit-stash nil
"List stashes and show stash diffs."
:group 'magit-modes)
;;;; Diff options
(defcustom magit-stash-sections-hook
'(magit-insert-stash-notes
magit-insert-stash-worktree
magit-insert-stash-index
magit-insert-stash-untracked)
"Hook run to insert sections into stash diff buffers."
:package-version '(magit . "2.1.0")
:group 'magit-stash
:type 'hook)
;;;; Log options
(defcustom magit-stashes-margin
(list (nth 0 magit-log-margin)
(nth 1 magit-log-margin)
'magit-log-margin-width nil
(nth 4 magit-log-margin))
"Format of the margin in `magit-stashes-mode' buffers.
The value has the form (INIT STYLE WIDTH AUTHOR AUTHOR-WIDTH).
If INIT is non-nil, then the margin is shown initially.
STYLE controls how to format the author or committer date.
It can be one of `age' (to show the age of the commit),
`age-abbreviated' (to abbreviate the time unit to a character),
or a string (suitable for `format-time-string') to show the
actual date. Option `magit-log-margin-show-committer-date'
controls which date is being displayed.
WIDTH controls the width of the margin. This exists for forward
compatibility and currently the value should not be changed.
AUTHOR controls whether the name of the author is also shown by
default.
AUTHOR-WIDTH has to be an integer. When the name of the author
is shown, then this specifies how much space is used to do so."
:package-version '(magit . "2.9.0")
:group 'magit-stash
:group 'magit-margin
:type magit-log-margin--custom-type
:initialize #'magit-custom-initialize-reset
:set-after '(magit-log-margin)
:set (apply-partially #'magit-margin-set-variable 'magit-stashes-mode))
;;; Commands
;;;###autoload (autoload 'magit-stash "magit-stash" nil t)
(transient-define-prefix magit-stash ()
"Stash uncommitted changes."
:man-page "git-stash"
["Arguments"
("-u" "Also save untracked files" ("-u" "--include-untracked"))
("-a" "Also save untracked and ignored files" ("-a" "--all"))]
[["Stash"
("z" "both" magit-stash-both)
("i" "index" magit-stash-index)
("w" "worktree" magit-stash-worktree)
("x" "keeping index" magit-stash-keep-index)
("P" "push" magit-stash-push :level 5)]
["Snapshot"
("Z" "both" magit-snapshot-both)
("I" "index" magit-snapshot-index)
("W" "worktree" magit-snapshot-worktree)
("r" "to wip ref" magit-wip-commit)]
["Use"
("a" "Apply" magit-stash-apply)
("p" "Pop" magit-stash-pop)
("k" "Drop" magit-stash-drop)]
["Inspect"
("l" "List" magit-stash-list)
("v" "Show" magit-stash-show)]
["Transform"
("b" "Branch" magit-stash-branch)
("B" "Branch here" magit-stash-branch-here)
("f" "Format patch" magit-stash-format-patch)]])
(defun magit-stash-arguments ()
(transient-args 'magit-stash))
;;;###autoload
(defun magit-stash-both (message &optional include-untracked)
"Create a stash of the index and working tree.
Untracked files are included according to infix arguments.
One prefix argument is equivalent to `--include-untracked'
while two prefix arguments are equivalent to `--all'."
(interactive
(progn (when (and (magit-merge-in-progress-p)
(not (magit-y-or-n-p "\
Stashing and resetting during a merge conflict. \
Applying the resulting stash won't restore the merge state. \
Proceed anyway? ")))
(user-error "Abort"))
(magit-stash-read-args)))
(magit-stash-save message t t include-untracked t))
;;;###autoload
(defun magit-stash-index (message)
"Create a stash of the index only.
Unstaged and untracked changes are not stashed. The stashed
changes are applied in reverse to both the index and the
worktree. This command can fail when the worktree is not clean.
Applying the resulting stash has the inverse effect."
(interactive (list (magit-stash-read-message)))
(magit-stash-save message t nil nil t 'worktree))
;;;###autoload
(defun magit-stash-worktree (message &optional include-untracked)
"Create a stash of unstaged changes in the working tree.
Untracked files are included according to infix arguments.
One prefix argument is equivalent to `--include-untracked'
while two prefix arguments are equivalent to `--all'."
(interactive (magit-stash-read-args))
(magit-stash-save message nil t include-untracked t 'index))
;;;###autoload
(defun magit-stash-keep-index (message &optional include-untracked)
"Create a stash of the index and working tree, keeping index intact.
Untracked files are included according to infix arguments.
One prefix argument is equivalent to `--include-untracked'
while two prefix arguments are equivalent to `--all'."
(interactive (magit-stash-read-args))
(magit-stash-save message t t include-untracked t 'index))
(defun magit-stash-read-args ()
(list (magit-stash-read-message)
(magit-stash-read-untracked)))
(defun magit-stash-read-untracked ()
(let ((prefix (prefix-numeric-value current-prefix-arg))
(args (magit-stash-arguments)))
(cond ((or (= prefix 16) (member "--all" args)) 'all)
((or (= prefix 4) (member "--include-untracked" args)) t))))
(defun magit-stash-read-message ()
(let* ((default (format "On %s: "
(or (magit-get-current-branch) "(no branch)")))
(input (magit-read-string "Stash message" default)))
(if (equal input default)
(concat default (magit-rev-format "%h %s"))
input)))
;;;###autoload
(defun magit-snapshot-both (&optional include-untracked)
"Create a snapshot of the index and working tree.
Untracked files are included according to infix arguments.
One prefix argument is equivalent to `--include-untracked'
while two prefix arguments are equivalent to `--all'."
(interactive (magit-snapshot-read-args))
(magit-snapshot-save t t include-untracked t))
;;;###autoload
(defun magit-snapshot-index ()
"Create a snapshot of the index only.
Unstaged and untracked changes are not stashed."
(interactive)
(magit-snapshot-save t nil nil t))
;;;###autoload
(defun magit-snapshot-worktree (&optional include-untracked)
"Create a snapshot of unstaged changes in the working tree.
Untracked files are included according to infix arguments.
One prefix argument is equivalent to `--include-untracked'
while two prefix arguments are equivalent to `--all'."
(interactive (magit-snapshot-read-args))
(magit-snapshot-save nil t include-untracked t))
(defun magit-snapshot-read-args ()
(list (magit-stash-read-untracked)))
(defun magit-snapshot-save (index worktree untracked &optional refresh)
(magit-stash-save (concat "WIP on " (magit-stash-summary))
index worktree untracked refresh t))
;;;###autoload (autoload 'magit-stash-push "magit-stash" nil t)
(transient-define-prefix magit-stash-push (&optional transient args)
"Create stash using \"git stash push\".
This differs from Magit's other stashing commands, which don't
use \"git stash\" and are generally more flexible but don't allow
specifying a list of files to be stashed."
:man-page "git-stash"
["Arguments"
(magit:-- :reader ,(-rpartial #'magit-read-files
#'magit-modified-files))
("-u" "Also save untracked files" ("-u" "--include-untracked"))
("-a" "Also save untracked and ignored files" ("-a" "--all"))
("-k" "Keep index" ("-k" "--keep-index"))
("-K" "Don't keep index" "--no-keep-index")]
["Actions"
("P" "push" magit-stash-push)]
(interactive (if (eq transient-current-command 'magit-stash-push)
(list nil (transient-args 'magit-stash-push))
(list t)))
(if transient
(transient-setup 'magit-stash-push)
(magit-run-git "stash" "push" args)))
;;;###autoload
(defun magit-stash-apply (stash)
"Apply a stash to the working tree.
Try to preserve the stash index. If that fails because there
are staged changes, apply without preserving the stash index."
(interactive (list (magit-read-stash "Apply stash")))
(if (= (magit-call-git "stash" "apply" "--index" stash) 0)
(magit-refresh)
(magit-run-git "stash" "apply" stash)))
;;;###autoload
(defun magit-stash-pop (stash)
"Apply a stash to the working tree and remove it from stash list.
Try to preserve the stash index. If that fails because there
are staged changes, apply without preserving the stash index
and forgo removing the stash."
(interactive (list (magit-read-stash "Pop stash")))
(if (= (magit-call-git "stash" "apply" "--index" stash) 0)
(magit-stash-drop stash)
(magit-run-git "stash" "apply" stash)))
;;;###autoload
(defun magit-stash-drop (stash)
"Remove a stash from the stash list.
When the region is active offer to drop all contained stashes."
(interactive
(list (--if-let (magit-region-values 'stash)
(magit-confirm 'drop-stashes nil "Drop %i stashes" nil it)
(magit-read-stash "Drop stash"))))
(dolist (stash (if (listp stash)
(nreverse (prog1 stash (setq stash (car stash))))
(list stash)))
(message "Deleted refs/%s (was %s)" stash
(magit-rev-parse "--short" stash))
(magit-call-git "rev-parse" stash)
(magit-call-git "stash" "drop" stash))
(magit-refresh))
;;;###autoload
(defun magit-stash-clear (ref)
"Remove all stashes saved in REF's reflog by deleting REF."
(interactive (let ((ref (or (magit-section-value-if 'stashes) "refs/stash")))
(magit-confirm t (format "Drop all stashes in %s" ref))
(list ref)))
(magit-run-git "update-ref" "-d" ref))
;;;###autoload
(defun magit-stash-branch (stash branch)
"Create and checkout a new BRANCH from STASH."
(interactive (list (magit-read-stash "Branch stash")
(magit-read-string-ns "Branch name")))
(magit-run-git "stash" "branch" branch stash))
;;;###autoload
(defun magit-stash-branch-here (stash branch)
"Create and checkout a new BRANCH and apply STASH.
The branch is created using `magit-branch-and-checkout', using the
current branch or `HEAD' as the start-point."
(interactive (list (magit-read-stash "Branch stash")
(magit-read-string-ns "Branch name")))
(let ((magit-inhibit-refresh t))
(magit-branch-and-checkout branch (or (magit-get-current-branch) "HEAD")))
(magit-stash-apply stash))
;;;###autoload
(defun magit-stash-format-patch (stash)
"Create a patch from STASH"
(interactive (list (magit-read-stash "Create patch from stash")))
(with-temp-file (magit-rev-format "0001-%f.patch" stash)
(magit-git-insert "stash" "show" "-p" stash))
(magit-refresh))
;;; Plumbing
(defun magit-stash-save (message index worktree untracked
&optional refresh keep noerror ref)
(if (or (and index (magit-staged-files t))
(and worktree (magit-unstaged-files t))
(and untracked (magit-untracked-files (eq untracked 'all))))
(magit-with-toplevel
(magit-stash-store message (or ref "refs/stash")
(magit-stash-create message index worktree untracked))
(if (eq keep 'worktree)
(with-temp-buffer
(magit-git-insert "diff" "--cached" "--no-ext-diff")
(magit-run-git-with-input
"apply" "--reverse" "--cached" "--ignore-space-change" "-")
(magit-run-git-with-input
"apply" "--reverse" "--ignore-space-change" "-"))
(unless (eq keep t)
(if (eq keep 'index)
(magit-call-git "checkout" "--" ".")
(magit-call-git "reset" "--hard" "HEAD" "--"))
(when untracked
(magit-call-git "clean" "--force" "-d"
(and (eq untracked 'all) "-x")))))
(when refresh
(magit-refresh)))
(unless noerror
(user-error "No %s changes to save" (cond ((not index) "unstaged")
((not worktree) "staged")
(t "local"))))))
(defun magit-stash-store (message ref commit)
(magit-update-ref ref message commit t))
(defun magit-stash-create (message index worktree untracked)
(unless (magit-rev-parse "--verify" "HEAD")
(error "You do not have the initial commit yet"))
(let ((magit-git-global-arguments (nconc (list "-c" "commit.gpgsign=false")
magit-git-global-arguments))
(default-directory (magit-toplevel))
(summary (magit-stash-summary))
(head "HEAD"))
(when (and worktree (not index))
(setq head (or (magit-commit-tree "pre-stash index" nil "HEAD")
(error "Cannot save the current index state"))))
(or (setq index (magit-commit-tree (concat "index on " summary) nil head))
(error "Cannot save the current index state"))
(and untracked
(setq untracked (magit-untracked-files (eq untracked 'all)))
(setq untracked (magit-with-temp-index nil nil
(or (and (magit-update-files untracked)
(magit-commit-tree
(concat "untracked files on " summary)))
(error "Cannot save the untracked files")))))
(magit-with-temp-index index "-m"
(when worktree
(or (magit-update-files (magit-git-items "diff" "-z" "--name-only" head))
(error "Cannot save the current worktree state")))
(or (magit-commit-tree message nil head index untracked)
(error "Cannot save the current worktree state")))))
(defun magit-stash-summary ()
(concat (or (magit-get-current-branch) "(no branch)")
": " (magit-rev-format "%h %s")))
;;; Sections
(defvar magit-stashes-section-map
(let ((map (make-sparse-keymap)))
(magit-menu-set map [magit-visit-thing] #'magit-stash-list "List %t")
(magit-menu-set map [magit-delete-thing] #'magit-stash-clear "Clear %t")
map)
"Keymap for `stashes' section.")
(defvar magit-stash-section-map
(let ((map (make-sparse-keymap)))
(magit-menu-set map [magit-visit-thing] #'magit-stash-show "Visit %v")
(magit-menu-set map [magit-delete-thing] #'magit-stash-drop "Delete %M")
(magit-menu-set map [magit-cherry-apply] #'magit-stash-apply "Apply %M")
(magit-menu-set map [magit-cherry-pick] #'magit-stash-pop "Pop %M")
map)
"Keymap for `stash' sections.")
(magit-define-section-jumper magit-jump-to-stashes
"Stashes" stashes "refs/stash")
(cl-defun magit-insert-stashes (&optional (ref "refs/stash")
(heading "Stashes:"))
"Insert `stashes' section showing reflog for \"refs/stash\".
If optional REF is non-nil, show reflog for that instead.
If optional HEADING is non-nil, use that as section heading
instead of \"Stashes:\"."
(let ((verified (magit-rev-verify ref))
(autostash (magit-rebase--get-state-lines "autostash")))
(when (or autostash verified)
(magit-insert-section (stashes ref)
(magit-insert-heading heading)
(when autostash
(pcase-let ((`(,author ,date ,msg)
(split-string
(car (magit-git-lines
"show" "-q" "--format=%aN%x00%at%x00%s"
autostash))
"\0")))
(magit-insert-section (stash autostash)
(insert (propertize "AUTOSTASH" 'font-lock-face 'magit-hash))
(insert " " msg "\n")
(save-excursion
(backward-char)
(magit-log-format-margin autostash author date)))))
(if verified
(magit-git-wash (apply-partially #'magit-log-wash-log 'stash)
"reflog" "--format=%gd%x00%aN%x00%at%x00%gs" ref)
(insert ?\n)
(save-excursion
(backward-char)
(magit-make-margin-overlay)))))))
;;; List Stashes
;;;###autoload
(defun magit-stash-list ()
"List all stashes in a buffer."
(interactive)
(magit-stashes-setup-buffer))
(define-derived-mode magit-stashes-mode magit-reflog-mode "Magit Stashes"
"Mode for looking at lists of stashes."
:group 'magit-log
(hack-dir-local-variables-non-file-buffer))
(defun magit-stashes-setup-buffer ()
(magit-setup-buffer #'magit-stashes-mode nil
(magit-buffer-refname "refs/stash")))
(defun magit-stashes-refresh-buffer ()
(magit-insert-section (stashesbuf)
(magit-insert-heading (if (equal magit-buffer-refname "refs/stash")
"Stashes:"
(format "Stashes [%s]:" magit-buffer-refname)))
(magit-git-wash (apply-partially #'magit-log-wash-log 'stash)
"reflog" "--format=%gd%x00%aN%x00%at%x00%gs" magit-buffer-refname)))
(cl-defmethod magit-buffer-value (&context (major-mode magit-stashes-mode))
magit-buffer-refname)
(defvar magit--update-stash-buffer nil)
(defun magit-stashes-maybe-update-stash-buffer (&optional _)
"When moving in the stashes buffer, update the stash buffer.
If there is no stash buffer in the same frame, then do nothing."
(when (derived-mode-p 'magit-stashes-mode)
(magit--maybe-update-stash-buffer)))
(defun magit--maybe-update-stash-buffer ()
(when-let* ((stash (magit-section-value-if 'stash))
(buffer (magit-get-mode-buffer 'magit-stash-mode nil t)))
(if magit--update-stash-buffer
(setq magit--update-stash-buffer (list stash buffer))
(setq magit--update-stash-buffer (list stash buffer))
(run-with-idle-timer
magit-update-other-window-delay nil
(let ((args (with-current-buffer buffer
(let ((magit-direct-use-buffer-arguments 'selected))
(magit-show-commit--arguments)))))
(lambda ()
(pcase-let ((`(,stash ,buf) magit--update-stash-buffer))
(setq magit--update-stash-buffer nil)
(when (buffer-live-p buf)
(let ((magit-display-buffer-noselect t))
(apply #'magit-stash-show stash args))))
(setq magit--update-stash-buffer nil)))))))
;;; Show Stash
;;;###autoload
(defun magit-stash-show (stash &optional args files)
"Show all diffs of a stash in a buffer."
(interactive (cons (or (and (not current-prefix-arg)
(magit-stash-at-point))
(magit-read-stash "Show stash"))
(pcase-let ((`(,args ,files)
(magit-diff-arguments 'magit-stash-mode)))
(list (delete "--stat" args) files))))
(magit-stash-setup-buffer stash args files))
(define-derived-mode magit-stash-mode magit-diff-mode "Magit Stash"
"Mode for looking at individual stashes."
:group 'magit-diff
(hack-dir-local-variables-non-file-buffer)
(setq magit--imenu-group-types '(commit)))
(defun magit-stash-setup-buffer (stash args files)
(magit-setup-buffer #'magit-stash-mode nil
(magit-buffer-revision stash)
(magit-buffer-range (format "%s^..%s" stash stash))
(magit-buffer-diff-args args)
(magit-buffer-diff-files files)))
(defun magit-stash-refresh-buffer ()
(magit-set-header-line-format
(concat (capitalize magit-buffer-revision) " "
(propertize (magit-rev-format "%s" magit-buffer-revision)
'font-lock-face
(list :weight 'normal :foreground
(face-attribute 'default :foreground)))))
(setq magit-buffer-revision-hash (magit-rev-parse magit-buffer-revision))
(magit-insert-section (stash)
(magit-run-section-hook 'magit-stash-sections-hook)))
(cl-defmethod magit-buffer-value (&context (major-mode magit-stash-mode))
magit-buffer-revision)
(defun magit-stash-insert-section (commit range message &optional files)
(magit-insert-section (commit commit)
(magit-insert-heading message)
(magit--insert-diff "diff" range "-p" "--no-prefix" magit-buffer-diff-args
"--" (or files magit-buffer-diff-files))))
(defun magit-insert-stash-notes ()
"Insert section showing notes for a stash.
This shows the notes for stash@{N} but not for the other commits
that make up the stash."
(magit-insert-section section (note)
(magit-insert-heading "Notes")
(magit-git-insert "notes" "show" magit-buffer-revision)
(if (= (point)
(oref section content))
(magit-cancel-section)
(insert "\n"))))
(defun magit-insert-stash-index ()
"Insert section showing staged changes of the stash."
(magit-stash-insert-section
(format "%s^2" magit-buffer-revision)
(format "%s^..%s^2" magit-buffer-revision magit-buffer-revision)
"Staged"))
(defun magit-insert-stash-worktree ()
"Insert section showing unstaged changes of the stash."
(magit-stash-insert-section
magit-buffer-revision
(format "%s^2..%s" magit-buffer-revision magit-buffer-revision)
"Unstaged"))
(defun magit-insert-stash-untracked ()
"Insert section showing the untracked files commit of the stash."
(let ((stash magit-buffer-revision)
(rev (concat magit-buffer-revision "^3")))
(when (magit-rev-verify rev)
(magit-stash-insert-section (format "%s^3" stash)
(format "%s^..%s^3" stash stash)
"Untracked files"
(magit-git-items "ls-tree" "-z" "--name-only"
"-r" "--full-tree" rev)))))
;;; _
(provide 'magit-stash)
;;; magit-stash.el ends here

833
code/elpa/magit-20220425.1153/magit-status.el Normal file
View file

@ -0,0 +1,833 @@
;;; magit-status.el --- The grand overview -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library implements the status buffer.
;;; Code:
(require 'magit)
;;; Options
(defgroup magit-status nil
"Inspect and manipulate Git repositories."
:link '(info-link "(magit)Status Buffer")
:group 'magit-modes)
(defcustom magit-status-mode-hook nil
"Hook run after entering Magit-Status mode."
:group 'magit-status
:type 'hook)
(defcustom magit-status-headers-hook
'(magit-insert-error-header
magit-insert-diff-filter-header
magit-insert-head-branch-header
magit-insert-upstream-branch-header
magit-insert-push-branch-header
magit-insert-tags-header)
"Hook run to insert headers into the status buffer.
This hook is run by `magit-insert-status-headers', which in turn
has to be a member of `magit-status-sections-hook' to be used at
all."
:package-version '(magit . "2.1.0")
:group 'magit-status
:type 'hook
:options '(magit-insert-error-header
magit-insert-diff-filter-header
magit-insert-repo-header
magit-insert-remote-header
magit-insert-head-branch-header
magit-insert-upstream-branch-header
magit-insert-push-branch-header
magit-insert-tags-header))
(defcustom magit-status-sections-hook
'(magit-insert-status-headers
magit-insert-merge-log
magit-insert-rebase-sequence
magit-insert-am-sequence
magit-insert-sequencer-sequence
magit-insert-bisect-output
magit-insert-bisect-rest
magit-insert-bisect-log
magit-insert-untracked-files
magit-insert-unstaged-changes
magit-insert-staged-changes
magit-insert-stashes
magit-insert-unpushed-to-pushremote
magit-insert-unpushed-to-upstream-or-recent
magit-insert-unpulled-from-pushremote
magit-insert-unpulled-from-upstream)
"Hook run to insert sections into a status buffer."
:package-version '(magit . "2.12.0")
:group 'magit-status
:type 'hook)
(defcustom magit-status-initial-section '(1)
"The section point is placed on when a status buffer is created.
When such a buffer is merely being refreshed or being shown again
after it was merely buried, then this option has no effect.
If this is nil, then point remains on the very first section as
usual. Otherwise it has to be a list of integers and section
identity lists. The members of that list are tried in order
until a matching section is found.
An integer means to jump to the nth section, 1 for example
jumps over the headings. To get a section's \"identity list\"
use \\[universal-argument] \\[magit-describe-section-briefly].
If, for example, you want to jump to the commits that haven't
been pulled from the upstream, or else the second section, then
use: (((unpulled . \"..@{upstream}\") (status)) 1).
See option `magit-section-initial-visibility-alist' for how to
control the initial visibility of the jumped to section."
:package-version '(magit . "2.90.0")
:group 'magit-status
:type '(choice (const :tag "as usual" nil)
(repeat (choice (number :tag "nth top-level section")
(sexp :tag "section identity")))))
(defcustom magit-status-goto-file-position nil
"Whether to go to position corresponding to file position.
If this is non-nil and the current buffer is visiting a file,
then `magit-status' tries to go to the position in the status
buffer that corresponds to the position in the file-visiting
buffer. This jumps into either the diff of unstaged changes
or the diff of staged changes.
If the previously current buffer does not visit a file, or if
the file has neither unstaged nor staged changes then this has
no effect.
The command `magit-status-here' tries to go to that position,
regardless of the value of this option."
:package-version '(magit . "3.0.0")
:group 'magit-status
:type 'boolean)
(defcustom magit-status-show-hashes-in-headers nil
"Whether headers in the status buffer show hashes.
The functions which respect this option are
`magit-insert-head-branch-header',
`magit-insert-upstream-branch-header', and
`magit-insert-push-branch-header'."
:package-version '(magit . "2.4.0")
:group 'magit-status
:type 'boolean)
(defcustom magit-status-margin
(list nil
(nth 1 magit-log-margin)
'magit-log-margin-width nil
(nth 4 magit-log-margin))
"Format of the margin in `magit-status-mode' buffers.
The value has the form (INIT STYLE WIDTH AUTHOR AUTHOR-WIDTH).
If INIT is non-nil, then the margin is shown initially.
STYLE controls how to format the author or committer date.
It can be one of `age' (to show the age of the commit),
`age-abbreviated' (to abbreviate the time unit to a character),
or a string (suitable for `format-time-string') to show the
actual date. Option `magit-log-margin-show-committer-date'
controls which date is being displayed.
WIDTH controls the width of the margin. This exists for forward
compatibility and currently the value should not be changed.
AUTHOR controls whether the name of the author is also shown by
default.
AUTHOR-WIDTH has to be an integer. When the name of the author
is shown, then this specifies how much space is used to do so."
:package-version '(magit . "2.9.0")
:group 'magit-status
:group 'magit-margin
:type magit-log-margin--custom-type
:initialize #'magit-custom-initialize-reset
:set-after '(magit-log-margin)
:set (apply-partially #'magit-margin-set-variable 'magit-status-mode))
(defcustom magit-status-use-buffer-arguments 'selected
"Whether `magit-status' reuses arguments when the buffer already exists.
This option has no effect when merely refreshing the status
buffer using `magit-refresh'.
Valid values are:
`always': Always use the set of arguments that is currently
active in the status buffer, provided that buffer exists
of course.
`selected': Use the set of arguments from the status
buffer, but only if it is displayed in a window of the
current frame. This is the default.
`current': Use the set of arguments from the status buffer,
but only if it is the current buffer.
`never': Never use the set of arguments from the status
buffer."
:package-version '(magit . "3.0.0")
:group 'magit-buffers
:group 'magit-commands
:type '(choice
(const :tag "always use args from buffer" always)
(const :tag "use args from buffer if displayed in frame" selected)
(const :tag "use args from buffer if it is current" current)
(const :tag "never use args from buffer" never)))
;;; Commands
;;;###autoload
(defun magit-init (directory)
"Initialize a Git repository, then show its status.
If the directory is below an existing repository, then the user
has to confirm that a new one should be created inside. If the
directory is the root of the existing repository, then the user
has to confirm that it should be reinitialized.
Non-interactively DIRECTORY is (re-)initialized unconditionally."
(interactive
(let ((directory (file-name-as-directory
(expand-file-name
(read-directory-name "Create repository in: ")))))
(when-let ((toplevel (magit-toplevel directory)))
(setq toplevel (expand-file-name toplevel))
(unless (y-or-n-p (if (file-equal-p toplevel directory)
(format "Reinitialize existing repository %s? "
directory)
(format "%s is a repository. Create another in %s? "
toplevel directory)))
(user-error "Abort")))
(list directory)))
;; `git init' does not understand the meaning of "~"!
(magit-call-git "init" (magit-convert-filename-for-git
(expand-file-name directory)))
(magit-status-setup-buffer directory))
;;;###autoload
(defun magit-status (&optional directory cache)
"Show the status of the current Git repository in a buffer.
If the current directory isn't located within a Git repository,
then prompt for an existing repository or an arbitrary directory,
depending on option `magit-repository-directories', and show the
status of the selected repository instead.
* If that option specifies any existing repositories, then offer
those for completion and show the status buffer for the
selected one.
* Otherwise read an arbitrary directory using regular file-name
completion. If the selected directory is the top-level of an
existing working tree, then show the status buffer for that.
* Otherwise offer to initialize the selected directory as a new
repository. After creating the repository show its status
buffer.
These fallback behaviors can also be forced using one or more
prefix arguments:
* With two prefix arguments (or more precisely a numeric prefix
value of 16 or greater) read an arbitrary directory and act on
it as described above. The same could be accomplished using
the command `magit-init'.
* With a single prefix argument read an existing repository, or
if none can be found based on `magit-repository-directories',
then fall back to the same behavior as with two prefix
arguments."
(interactive
(let ((magit--refresh-cache (list (cons 0 0))))
(list (and (or current-prefix-arg (not (magit-toplevel)))
(progn (magit--assert-usable-git)
(magit-read-repository
(>= (prefix-numeric-value current-prefix-arg) 16))))
magit--refresh-cache)))
(let ((magit--refresh-cache (or cache (list (cons 0 0)))))
(if directory
(let ((toplevel (magit-toplevel directory)))
(setq directory (file-name-as-directory
(expand-file-name directory)))
(if (and toplevel (file-equal-p directory toplevel))
(magit-status-setup-buffer directory)
(when (y-or-n-p
(if toplevel
(format "%s is a repository. Create another in %s? "
toplevel directory)
(format "Create repository in %s? " directory)))
;; Creating a new repository invalidates cached values.
(setq magit--refresh-cache nil)
(magit-init directory))))
(magit-status-setup-buffer default-directory))))
(put 'magit-status 'interactive-only 'magit-status-setup-buffer)
;;;###autoload
(defalias 'magit #'magit-status
"An alias for `magit-status' for better discoverability.
Instead of invoking this alias for `magit-status' using
\"M-x magit RET\", you should bind a key to `magit-status'
and read the info node `(magit)Getting Started', which
also contains other useful hints.")
;;;###autoload
(defun magit-status-here ()
"Like `magit-status' but with non-nil `magit-status-goto-file-position'."
(interactive)
(let ((magit-status-goto-file-position t))
(call-interactively #'magit-status)))
(put 'magit-status-here 'interactive-only 'magit-status-setup-buffer)
;;;###autoload
(defun magit-status-quick ()
"Show the status of the current Git repository, maybe without refreshing.
If the status buffer of the current Git repository exists but
isn't being displayed in the selected frame, then display it
without refreshing it.
If the status buffer is being displayed in the selected frame,
then also refresh it.
Prefix arguments have the same meaning as for `magit-status',
and additionally cause the buffer to be refresh.
To use this function instead of `magit-status', add this to your
init file: (global-set-key (kbd \"C-x g\") 'magit-status-quick)."
(interactive)
(if-let ((buffer
(and (not current-prefix-arg)
(not (magit-get-mode-buffer 'magit-status-mode nil 'selected))
(magit-get-mode-buffer 'magit-status-mode))))
(magit-display-buffer buffer)
(call-interactively #'magit-status)))
;;; Mode
(defvar magit-status-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map magit-mode-map)
(define-key map "j" #'magit-status-jump)
(define-key map [remap dired-jump] #'magit-dired-jump)
map)
"Keymap for `magit-status-mode'.")
(transient-define-prefix magit-status-jump ()
"In a Magit-Status buffer, jump to a section."
["Jump to"
[("z " "Stashes" magit-jump-to-stashes
:if (lambda () (memq 'magit-insert-stashes magit-status-sections-hook)))
("t " "Tracked" magit-jump-to-tracked
:if (lambda () (memq 'magit-insert-tracked-files magit-status-sections-hook)))
("n " "Untracked" magit-jump-to-untracked
:if (lambda () (memq 'magit-insert-untracked-files magit-status-sections-hook)))
("u " "Unstaged" magit-jump-to-unstaged
:if (lambda () (memq 'magit-insert-unstaged-changes magit-status-sections-hook)))
("s " "Staged" magit-jump-to-staged
:if (lambda () (memq 'magit-insert-staged-changes magit-status-sections-hook)))]
[("fu" "Unpulled from upstream" magit-jump-to-unpulled-from-upstream
:if (lambda () (memq 'magit-insert-unpulled-from-upstream magit-status-sections-hook)))
("fp" "Unpulled from pushremote" magit-jump-to-unpulled-from-pushremote
:if (lambda () (memq 'magit-insert-unpulled-from-pushremote magit-status-sections-hook)))
("pu" magit-jump-to-unpushed-to-upstream
:if (lambda ()
(or (memq 'magit-insert-unpushed-to-upstream-or-recent magit-status-sections-hook)
(memq 'magit-insert-unpushed-to-upstream magit-status-sections-hook)))
:description (lambda ()
(let ((upstream (magit-get-upstream-branch)))
(if (or (not upstream)
(magit-rev-ancestor-p "HEAD" upstream))
"Recent commits"
"Unmerged into upstream"))))
("pp" "Unpushed to pushremote" magit-jump-to-unpushed-to-pushremote
:if (lambda () (memq 'magit-insert-unpushed-to-pushremote magit-status-sections-hook)))
("a " "Assumed unstaged" magit-jump-to-assume-unchanged
:if (lambda () (memq 'magit-insert-assume-unchanged-files magit-status-sections-hook)))
("w " "Skip worktree" magit-jump-to-skip-worktree
:if (lambda () (memq 'magit-insert-skip-worktree-files magit-status-sections-hook)))]
[("i" "Using Imenu" imenu)]])
(define-derived-mode magit-status-mode magit-mode "Magit"
"Mode for looking at Git status.
This mode is documented in info node `(magit)Status Buffer'.
\\<magit-mode-map>\
Type \\[magit-refresh] to refresh the current buffer.
Type \\[magit-section-toggle] to expand or hide the section at point.
Type \\[magit-visit-thing] to visit the change or commit at point.
Type \\[magit-dispatch] to invoke major commands.
Staging and applying changes is documented in info node
`(magit)Staging and Unstaging' and info node `(magit)Applying'.
\\<magit-hunk-section-map>Type \
\\[magit-apply] to apply the change at point, \
\\[magit-stage] to stage,
\\[magit-unstage] to unstage, \
\\[magit-discard] to discard, or \
\\[magit-reverse] to reverse it.
\\<magit-status-mode-map>\
Type \\[magit-commit] to create a commit.
\\{magit-status-mode-map}"
:group 'magit-status
(hack-dir-local-variables-non-file-buffer)
(setq magit--imenu-group-types '(not branch commit)))
(put 'magit-status-mode 'magit-diff-default-arguments
'("--no-ext-diff"))
(put 'magit-status-mode 'magit-log-default-arguments
'("-n256" "--decorate"))
;;;###autoload
(defun magit-status-setup-buffer (&optional directory)
(unless directory
(setq directory default-directory))
(when (file-remote-p directory)
(magit-git-version-assert))
(let* ((default-directory directory)
(d (magit-diff--get-value 'magit-status-mode
magit-status-use-buffer-arguments))
(l (magit-log--get-value 'magit-status-mode
magit-status-use-buffer-arguments))
(file (and magit-status-goto-file-position
(magit-file-relative-name)))
(line (and file (line-number-at-pos)))
(col (and file (current-column)))
(buf (magit-setup-buffer #'magit-status-mode nil
(magit-buffer-diff-args (nth 0 d))
(magit-buffer-diff-files (nth 1 d))
(magit-buffer-log-args (nth 0 l))
(magit-buffer-log-files (nth 1 l)))))
(when file
(with-current-buffer buf
(let ((staged (magit-get-section '((staged) (status)))))
(if (and staged
(cadr (magit-diff--locate-hunk file line staged)))
(magit-diff--goto-position file line col staged)
(let ((unstaged (magit-get-section '((unstaged) (status)))))
(unless (and unstaged
(magit-diff--goto-position file line col unstaged))
(when staged
(magit-diff--goto-position file line col staged))))))))
buf))
(defun magit-status-refresh-buffer ()
(magit-git-exit-code "update-index" "--refresh")
(magit-insert-section (status)
(magit-run-section-hook 'magit-status-sections-hook)))
(defun magit-status-goto-initial-section ()
"In a `magit-status-mode' buffer, jump `magit-status-initial-section'.
Actually doing so is deferred until `magit-refresh-buffer-hook'
runs `magit-status-goto-initial-section-1'. That function then
removes itself from the hook, so that this only happens when the
status buffer is first created."
(when (and magit-status-initial-section
(derived-mode-p 'magit-status-mode))
(add-hook 'magit-refresh-buffer-hook
#'magit-status-goto-initial-section-1 nil t)))
(defun magit-status-goto-initial-section-1 ()
"In a `magit-status-mode' buffer, jump `magit-status-initial-section'.
This function removes itself from `magit-refresh-buffer-hook'."
(when-let ((section
(--some (if (integerp it)
(nth (1- it)
(magit-section-siblings (magit-current-section)
'next))
(magit-get-section it))
magit-status-initial-section)))
(goto-char (oref section start))
(when-let ((vis (cdr (assq 'magit-status-initial-section
magit-section-initial-visibility-alist))))
(if (eq vis 'hide)
(magit-section-hide section)
(magit-section-show section))))
(remove-hook 'magit-refresh-buffer-hook
#'magit-status-goto-initial-section-1 t))
(defun magit-status-maybe-update-revision-buffer (&optional _)
"When moving in the status buffer, update the revision buffer.
If there is no revision buffer in the same frame, then do nothing."
(when (derived-mode-p 'magit-status-mode)
(magit--maybe-update-revision-buffer)))
(defun magit-status-maybe-update-stash-buffer (&optional _)
"When moving in the status buffer, update the stash buffer.
If there is no stash buffer in the same frame, then do nothing."
(when (derived-mode-p 'magit-status-mode)
(magit--maybe-update-stash-buffer)))
(defun magit-status-maybe-update-blob-buffer (&optional _)
"When moving in the status buffer, update the blob buffer.
If there is no blob buffer in the same frame, then do nothing."
(when (derived-mode-p 'magit-status-mode)
(magit--maybe-update-blob-buffer)))
;;; Sections
;;;; Special Headers
(defun magit-insert-status-headers ()
"Insert header sections appropriate for `magit-status-mode' buffers.
The sections are inserted by running the functions on the hook
`magit-status-headers-hook'."
(if (magit-rev-verify "HEAD")
(magit-insert-headers 'magit-status-headers-hook)
(insert "In the beginning there was darkness\n\n")))
(defvar magit-error-section-map
(let ((map (make-sparse-keymap)))
(magit-menu-set map [magit-visit-thing]
#'magit-process-buffer "Visit process output")
map)
"Keymap for `error' sections.")
(defun magit-insert-error-header ()
"Insert the message about the Git error that just occurred.
This function is only aware of the last error that occur when Git
was run for side-effects. If, for example, an error occurs while
generating a diff, then that error won't be inserted. Refreshing
the status buffer causes this section to disappear again."
(when magit-this-error
(magit-insert-section (error 'git)
(insert (propertize (format "%-10s" "GitError! ")
'font-lock-face 'magit-section-heading))
(insert (propertize magit-this-error 'font-lock-face 'error))
(when-let ((key (car (where-is-internal 'magit-process-buffer))))
(insert (format " [Type `%s' for details]" (key-description key))))
(insert ?\n))
(setq magit-this-error nil)))
(defun magit-insert-diff-filter-header ()
"Insert a header line showing the effective diff filters."
(let ((ignore-modules (magit-ignore-submodules-p)))
(when (or ignore-modules
magit-buffer-diff-files)
(insert (propertize (format "%-10s" "Filter! ")
'font-lock-face 'magit-section-heading))
(when ignore-modules
(insert ignore-modules)
(when magit-buffer-diff-files
(insert " -- ")))
(when magit-buffer-diff-files
(insert (mapconcat #'identity magit-buffer-diff-files " ")))
(insert ?\n))))
;;;; Reference Headers
(defun magit-insert-head-branch-header (&optional branch)
"Insert a header line about the current branch.
If `HEAD' is detached, then insert information about that commit
instead. The optional BRANCH argument is for internal use only."
(let ((branch (or branch (magit-get-current-branch)))
(output (magit-rev-format "%h %s" (or branch "HEAD"))))
(string-match "^\\([^ ]+\\) \\(.*\\)" output)
(magit-bind-match-strings (commit summary) output
(when (equal summary "")
(setq summary "(no commit message)"))
(if branch
(magit-insert-section (branch branch)
(insert (format "%-10s" "Head: "))
(when magit-status-show-hashes-in-headers
(insert (propertize commit 'font-lock-face 'magit-hash) ?\s))
(insert (propertize branch 'font-lock-face 'magit-branch-local))
(insert ?\s)
(insert (funcall magit-log-format-message-function branch summary))
(insert ?\n))
(magit-insert-section (commit commit)
(insert (format "%-10s" "Head: "))
(insert (propertize commit 'font-lock-face 'magit-hash))
(insert ?\s)
(insert (funcall magit-log-format-message-function nil summary))
(insert ?\n))))))
(defun magit-insert-upstream-branch-header (&optional branch upstream keyword)
"Insert a header line about the upstream of the current branch.
If no branch is checked out, then insert nothing. The optional
arguments are for internal use only."
(when-let ((branch (or branch (magit-get-current-branch))))
(let ((remote (magit-get "branch" branch "remote"))
(merge (magit-get "branch" branch "merge"))
(rebase (magit-get "branch" branch "rebase")))
(when (or remote merge)
(unless upstream
(setq upstream (magit-get-upstream-branch branch)))
(magit-insert-section (branch upstream)
(pcase rebase
("true")
("false" (setq rebase nil))
(_ (setq rebase (magit-get-boolean "pull.rebase"))))
(insert (format "%-10s" (or keyword (if rebase "Rebase: " "Merge: "))))
(insert
(if upstream
(concat (and magit-status-show-hashes-in-headers
(concat (propertize (magit-rev-format "%h" upstream)
'font-lock-face 'magit-hash)
" "))
upstream " "
(funcall magit-log-format-message-function upstream
(funcall magit-log-format-message-function nil
(or (magit-rev-format "%s" upstream)
"(no commit message)"))))
(cond
((magit--unnamed-upstream-p remote merge)
(concat (propertize merge 'font-lock-face 'magit-branch-remote)
" from "
(propertize remote 'font-lock-face 'bold)))
((magit--valid-upstream-p remote merge)
(if (equal remote ".")
(concat
(propertize merge 'font-lock-face 'magit-branch-local) " "
(propertize "does not exist"
'font-lock-face 'magit-branch-warning))
(format
"%s %s %s"
(propertize merge 'font-lock-face 'magit-branch-remote)
(propertize "does not exist on"
'font-lock-face 'magit-branch-warning)
(propertize remote 'font-lock-face 'magit-branch-remote))))
(t
(propertize "invalid upstream configuration"
'font-lock-face 'magit-branch-warning)))))
(insert ?\n))))))
(defun magit-insert-push-branch-header ()
"Insert a header line about the branch the current branch is pushed to."
(when-let* ((branch (magit-get-current-branch))
(target (magit-get-push-branch branch)))
(magit-insert-section (branch target)
(insert (format "%-10s" "Push: "))
(insert
(if (magit-rev-verify target)
(concat (and magit-status-show-hashes-in-headers
(concat (propertize (magit-rev-format "%h" target)
'font-lock-face 'magit-hash)
" "))
target " "
(funcall magit-log-format-message-function target
(funcall magit-log-format-message-function nil
(or (magit-rev-format "%s" target)
"(no commit message)"))))
(let ((remote (magit-get-push-remote branch)))
(if (magit-remote-p remote)
(concat target " "
(propertize "does not exist"
'font-lock-face 'magit-branch-warning))
(concat remote " "
(propertize "remote does not exist"
'font-lock-face 'magit-branch-warning))))))
(insert ?\n))))
(defun magit-insert-tags-header ()
"Insert a header line about the current and/or next tag."
(let* ((this-tag (magit-get-current-tag nil t))
(next-tag (magit-get-next-tag nil t))
(this-cnt (cadr this-tag))
(next-cnt (cadr next-tag))
(this-tag (car this-tag))
(next-tag (car next-tag))
(both-tags (and this-tag next-tag t)))
(when (or this-tag next-tag)
(magit-insert-section (tag (or this-tag next-tag))
(insert (format "%-10s" (if both-tags "Tags: " "Tag: ")))
(cl-flet ((insert-count (tag count face)
(insert (concat (propertize tag 'font-lock-face 'magit-tag)
(and (> count 0)
(format " (%s)"
(propertize
(format "%s" count)
'font-lock-face face)))))))
(when this-tag (insert-count this-tag this-cnt 'magit-branch-local))
(when both-tags (insert ", "))
(when next-tag (insert-count next-tag next-cnt 'magit-tag)))
(insert ?\n)))))
;;;; Auxiliary Headers
(defun magit-insert-user-header ()
"Insert a header line about the current user."
(let ((name (magit-get "user.name"))
(email (magit-get "user.email")))
(when (and name email)
(magit-insert-section (user name)
(insert (format "%-10s" "User: "))
(insert (propertize name 'font-lock-face 'magit-log-author))
(insert " <" email ">\n")))))
(defun magit-insert-repo-header ()
"Insert a header line showing the path to the repository top-level."
(let ((topdir (magit-toplevel)))
(magit-insert-section (repo topdir)
(insert (format "%-10s%s\n" "Repo: " (abbreviate-file-name topdir))))))
(defun magit-insert-remote-header ()
"Insert a header line about the remote of the current branch.
If no remote is configured for the current branch, then fall back
showing the \"origin\" remote, or if that does not exist the first
remote in alphabetic order."
(when-let* ((name (magit-get-some-remote))
;; Under certain configurations it's possible for
;; url to be nil, when name is not, see #2858.
(url (magit-get "remote" name "url")))
(magit-insert-section (remote name)
(insert (format "%-10s" "Remote: "))
(insert (propertize name 'font-lock-face 'magit-branch-remote) ?\s)
(insert url ?\n))))
;;;; File Sections
(defvar magit-untracked-section-map
(let ((map (make-sparse-keymap)))
(magit-menu-set map [magit-stage-file] #'magit-stage "Stage files")
(magit-menu-set map [magit-delete-thing] #'magit-discard "Discard files")
map)
"Keymap for the `untracked' section.")
(magit-define-section-jumper magit-jump-to-untracked "Untracked files" untracked)
(defun magit-insert-untracked-files ()
"Maybe insert a list or tree of untracked files.
Do so depending on the value of `status.showUntrackedFiles'.
Note that even if the value is `all', Magit still initially
only shows directories. But the directory sections can then
be expanded using \"TAB\".
If the first element of `magit-buffer-diff-files' is a
directory, then limit the list to files below that. The value
value of that variable can be set using \"D -- DIRECTORY RET g\"."
(let* ((show (or (magit-get "status.showUntrackedFiles") "normal"))
(base (car magit-buffer-diff-files))
(base (and base (file-directory-p base) base)))
(unless (equal show "no")
(if (equal show "all")
(when-let ((files (magit-untracked-files nil base)))
(magit-insert-section (untracked)
(magit-insert-heading "Untracked files:")
(magit-insert-files files base)
(insert ?\n)))
(when-let ((files
(--mapcat (and (eq (aref it 0) ??)
(list (substring it 3)))
(magit-git-items "status" "-z" "--porcelain"
(magit-ignore-submodules-p t)
"--" base))))
(magit-insert-section (untracked)
(magit-insert-heading "Untracked files:")
(dolist (file files)
(magit-insert-section (file file)
(insert (propertize file 'font-lock-face 'magit-filename) ?\n)))
(insert ?\n)))))))
(magit-define-section-jumper magit-jump-to-tracked "Tracked files" tracked)
(defun magit-insert-tracked-files ()
"Insert a tree of tracked files.
If the first element of `magit-buffer-diff-files' is a
directory, then limit the list to files below that. The value
value of that variable can be set using \"D -- DIRECTORY RET g\"."
(when-let ((files (magit-list-files)))
(let* ((base (car magit-buffer-diff-files))
(base (and base (file-directory-p base) base)))
(magit-insert-section (tracked nil t)
(magit-insert-heading "Tracked files:")
(magit-insert-files files base)
(insert ?\n)))))
(defun magit-insert-ignored-files ()
"Insert a tree of ignored files.
If the first element of `magit-buffer-diff-files' is a
directory, then limit the list to files below that. The value
of that variable can be set using \"D -- DIRECTORY RET g\"."
(when-let ((files (magit-ignored-files)))
(let* ((base (car magit-buffer-diff-files))
(base (and base (file-directory-p base) base)))
(magit-insert-section (tracked nil t)
(magit-insert-heading "Ignored files:")
(magit-insert-files files base)
(insert ?\n)))))
(magit-define-section-jumper magit-jump-to-skip-worktree "Skip-worktree files" skip-worktree)
(defun magit-insert-skip-worktree-files ()
"Insert a tree of skip-worktree files.
If the first element of `magit-buffer-diff-files' is a
directory, then limit the list to files below that. The value
of that variable can be set using \"D -- DIRECTORY RET g\"."
(when-let ((files (magit-skip-worktree-files)))
(let* ((base (car magit-buffer-diff-files))
(base (and base (file-directory-p base) base)))
(magit-insert-section (skip-worktree nil t)
(magit-insert-heading "Skip-worktree files:")
(magit-insert-files files base)
(insert ?\n)))))
(magit-define-section-jumper magit-jump-to-assume-unchanged "Assume-unchanged files" assume-unchanged)
(defun magit-insert-assume-unchanged-files ()
"Insert a tree of files that are assumed to be unchanged.
If the first element of `magit-buffer-diff-files' is a
directory, then limit the list to files below that. The value
of that variable can be set using \"D -- DIRECTORY RET g\"."
(when-let ((files (magit-assume-unchanged-files)))
(let* ((base (car magit-buffer-diff-files))
(base (and base (file-directory-p base) base)))
(magit-insert-section (assume-unchanged nil t)
(magit-insert-heading "Assume-unchanged files:")
(magit-insert-files files base)
(insert ?\n)))))
(defun magit-insert-files (files directory)
(while (and files (string-prefix-p (or directory "") (car files)))
(let ((dir (file-name-directory (car files))))
(if (equal dir directory)
(let ((file (pop files)))
(magit-insert-section (file file)
(insert (propertize file 'font-lock-face 'magit-filename) ?\n)))
(magit-insert-section (file dir t)
(insert (propertize dir 'file 'magit-filename) ?\n)
(magit-insert-heading)
(setq files (magit-insert-files files dir))))))
files)
;;; _
(provide 'magit-status)
;;; magit-status.el ends here

719
code/elpa/magit-20220425.1153/magit-submodule.el Normal file
View file

@ -0,0 +1,719 @@
;;; magit-submodule.el --- Submodule support for Magit -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
(require 'magit)
(defvar x-stretch-cursor)
;;; Options
(defcustom magit-module-sections-hook
'(magit-insert-modules-overview
magit-insert-modules-unpulled-from-upstream
magit-insert-modules-unpulled-from-pushremote
magit-insert-modules-unpushed-to-upstream
magit-insert-modules-unpushed-to-pushremote)
"Hook run by `magit-insert-modules'.
That function isn't part of `magit-status-sections-hook's default
value, so you have to add it yourself for this hook to have any
effect."
:package-version '(magit . "2.11.0")
:group 'magit-status
:type 'hook)
(defcustom magit-module-sections-nested t
"Whether `magit-insert-modules' wraps inserted sections.
If this is non-nil, then only a single top-level section
is inserted. If it is nil, then all sections listed in
`magit-module-sections-hook' become top-level sections."
:package-version '(magit . "2.11.0")
:group 'magit-status
:type 'boolean)
(defcustom magit-submodule-list-mode-hook '(hl-line-mode)
"Hook run after entering Magit-Submodule-List mode."
:package-version '(magit . "2.9.0")
:group 'magit-repolist
:type 'hook
:get 'magit-hook-custom-get
:options '(hl-line-mode))
(defcustom magit-submodule-list-columns
'(("Path" 25 magit-modulelist-column-path nil)
("Version" 25 magit-repolist-column-version
((:sort magit-repolist-version<)))
("Branch" 20 magit-repolist-column-branch nil)
("B<U" 3 magit-repolist-column-unpulled-from-upstream
((:right-align t)
(:sort <)))
("B>U" 3 magit-repolist-column-unpushed-to-upstream
((:right-align t)
(:sort <)))
("B<P" 3 magit-repolist-column-unpulled-from-pushremote
((:right-align t)
(:sort <)))
("B>P" 3 magit-repolist-column-unpushed-to-pushremote
((:right-align t)
(:sort <)))
("B" 3 magit-repolist-column-branches
((:right-align t)
(:sort <)))
("S" 3 magit-repolist-column-stashes
((:right-align t)
(:sort <))))
"List of columns displayed by `magit-list-submodules'.
Each element has the form (HEADER WIDTH FORMAT PROPS).
HEADER is the string displayed in the header. WIDTH is the width
of the column. FORMAT is a function that is called with one
argument, the repository identification (usually its basename),
and with `default-directory' bound to the toplevel of its working
tree. It has to return a string to be inserted or nil. PROPS is
an alist that supports the keys `:right-align', `:pad-right' and
`:sort'.
The `:sort' function has a weird interface described in the
docstring of `tabulated-list--get-sort'. Alternatively `<' and
`magit-repolist-version<' can be used as those functions are
automatically replaced with functions that satisfy the interface.
Set `:sort' to nil to inhibit sorting; if unspecifed, then the
column is sortable using the default sorter.
You may wish to display a range of numeric columns using just one
character per column and without any padding between columns, in
which case you should use an appropriat HEADER, set WIDTH to 1,
and set `:pad-right' to 0. \"+\" is substituted for numbers higher
than 9."
:package-version '(magit . "2.8.0")
:group 'magit-repolist
:type `(repeat (list :tag "Column"
(string :tag "Header Label")
(integer :tag "Column Width")
(function :tag "Inserter Function")
(repeat :tag "Properties"
(list (choice :tag "Property"
(const :right-align)
(const :pad-right)
(const :sort)
(symbol))
(sexp :tag "Value"))))))
(defcustom magit-submodule-list-sort-key '("Path" . nil)
"Initial sort key for buffer created by `magit-list-submodules'.
If nil, no additional sorting is performed. Otherwise, this
should be a cons cell (NAME . FLIP). NAME is a string matching
one of the column names in `magit-submodule-list-columns'. FLIP,
if non-nil, means to invert the resulting sort."
:package-version '(magit . "3.2.0")
:group 'magit-repolist
:type '(choice (const nil)
(cons (string :tag "Column name")
(boolean :tag "Flip order"))))
(defcustom magit-submodule-remove-trash-gitdirs nil
"Whether `magit-submodule-remove' offers to trash module gitdirs.
If this is nil, then that command does not offer to do so unless
a prefix argument is used. When this is t, then it does offer to
do so even without a prefix argument.
In both cases the action still has to be confirmed unless that is
disabled using the option `magit-no-confirm'. Doing the latter
and also setting this variable to t will lead to tears."
:package-version '(magit . "2.90.0")
:group 'magit-commands
:type 'boolean)
;;; Popup
;;;###autoload (autoload 'magit-submodule "magit-submodule" nil t)
(transient-define-prefix magit-submodule ()
"Act on a submodule."
:man-page "git-submodule"
["Arguments"
("-f" "Force" ("-f" "--force"))
("-r" "Recursive" "--recursive")
("-N" "Do not fetch" ("-N" "--no-fetch"))
("-C" "Checkout tip" "--checkout")
("-R" "Rebase onto tip" "--rebase")
("-M" "Merge tip" "--merge")
("-U" "Use upstream tip" "--remote")]
["One module actions"
("a" magit-submodule-add)
("r" magit-submodule-register)
("p" magit-submodule-populate)
("u" magit-submodule-update)
("s" magit-submodule-synchronize)
("d" magit-submodule-unpopulate)
("k" "Remove" magit-submodule-remove)]
["All modules actions"
("l" "List all modules" magit-list-submodules)
("f" "Fetch all modules" magit-fetch-modules)])
(defun magit-submodule-arguments (&rest filters)
(--filter (and (member it filters) it)
(transient-args 'magit-submodule)))
(defclass magit--git-submodule-suffix (transient-suffix)
())
(cl-defmethod transient-format-description ((obj magit--git-submodule-suffix))
(let ((value (delq nil (mapcar #'transient-infix-value transient--suffixes))))
(replace-regexp-in-string
"\\[--[^]]+\\]"
(lambda (match)
(format (propertize "[%s]" 'face 'transient-inactive-argument)
(mapconcat (lambda (arg)
(propertize arg 'face
(if (member arg value)
'transient-argument
'transient-inactive-argument)))
(save-match-data
(split-string (substring match 1 -1) "|"))
(propertize "|" 'face 'transient-inactive-argument))))
(cl-call-next-method obj))))
;;;###autoload (autoload 'magit-submodule-add "magit-submodule" nil t)
(transient-define-suffix magit-submodule-add (url &optional path name args)
"Add the repository at URL as a module.
Optional PATH is the path to the module relative to the root of
the superproject. If it is nil, then the path is determined
based on the URL. Optional NAME is the name of the module. If
it is nil, then PATH also becomes the name."
:class 'magit--git-submodule-suffix
:description "Add git submodule add [--force]"
(interactive
(magit-with-toplevel
(let* ((url (magit-read-string-ns "Add submodule (remote url)"))
(path (let ((read-file-name-function
(if (or (eq read-file-name-function 'ido-read-file-name)
(advice-function-member-p
'ido-read-file-name
read-file-name-function))
;; The Ido variant doesn't work properly here.
#'read-file-name-default
read-file-name-function)))
(directory-file-name
(file-relative-name
(read-directory-name
"Add submodules at path: " nil nil nil
(and (string-match "\\([^./]+\\)\\(\\.git\\)?$" url)
(match-string 1 url))))))))
(list url
(directory-file-name path)
(magit-submodule-read-name-for-path path)
(magit-submodule-arguments "--force")))))
(magit-submodule-add-1 url path name args))
(defun magit-submodule-add-1 (url &optional path name args)
(magit-with-toplevel
(magit-submodule--maybe-reuse-gitdir name path)
(magit-run-git-async "submodule" "add"
(and name (list "--name" name))
args "--" url path)
(set-process-sentinel
magit-this-process
(lambda (process event)
(when (memq (process-status process) '(exit signal))
(if (> (process-exit-status process) 0)
(magit-process-sentinel process event)
(process-put process 'inhibit-refresh t)
(magit-process-sentinel process event)
(when (magit-git-version>= "2.12.0")
(magit-call-git "submodule" "absorbgitdirs" path))
(magit-refresh)))))))
;;;###autoload
(defun magit-submodule-read-name-for-path (path &optional prefer-short)
(let* ((path (directory-file-name (file-relative-name path)))
(name (file-name-nondirectory path)))
(push (if prefer-short path name) minibuffer-history)
(magit-read-string-ns
"Submodule name" nil (cons 'minibuffer-history 2)
(or (--keep (pcase-let ((`(,var ,val) (split-string it "=")))
(and (equal val path)
(cadr (split-string var "\\."))))
(magit-git-lines "config" "--list" "-f" ".gitmodules"))
(if prefer-short name path)))))
;;;###autoload (autoload 'magit-submodule-register "magit-submodule" nil t)
(transient-define-suffix magit-submodule-register (modules)
"Register MODULES.
With a prefix argument act on all suitable modules. Otherwise,
if the region selects modules, then act on those. Otherwise, if
there is a module at point, then act on that. Otherwise read a
single module from the user."
;; This command and the underlying "git submodule init" do NOT
;; "initialize" modules. They merely "register" modules in the
;; super-projects $GIT_DIR/config file, the purpose of which is to
;; allow users to change such values before actually initializing
;; the modules.
:description "Register git submodule init"
(interactive
(list (magit-module-confirm "Register" 'magit-module-no-worktree-p)))
(magit-with-toplevel
(magit-run-git-async "submodule" "init" "--" modules)))
;;;###autoload (autoload 'magit-submodule-populate "magit-submodule" nil t)
(transient-define-suffix magit-submodule-populate (modules)
"Create MODULES working directories, checking out the recorded commits.
With a prefix argument act on all suitable modules. Otherwise,
if the region selects modules, then act on those. Otherwise, if
there is a module at point, then act on that. Otherwise read a
single module from the user."
;; This is the command that actually "initializes" modules.
;; A module is initialized when it has a working directory,
;; a gitlink, and a .gitmodules entry.
:description "Populate git submodule update --init"
(interactive
(list (magit-module-confirm "Populate" 'magit-module-no-worktree-p)))
(magit-with-toplevel
(magit-run-git-async "submodule" "update" "--init" "--" modules)))
;;;###autoload (autoload 'magit-submodule-update "magit-submodule" nil t)
(transient-define-suffix magit-submodule-update (modules args)
"Update MODULES by checking out the recorded commits.
With a prefix argument act on all suitable modules. Otherwise,
if the region selects modules, then act on those. Otherwise, if
there is a module at point, then act on that. Otherwise read a
single module from the user."
;; Unlike `git-submodule's `update' command ours can only update
;; "initialized" modules by checking out other commits but not
;; "initialize" modules by creating the working directories.
;; To do the latter we provide the "setup" command.
:class 'magit--git-submodule-suffix
:description "Update git submodule update [--force] [--no-fetch]
[--remote] [--recursive] [--checkout|--rebase|--merge]"
(interactive
(list (magit-module-confirm "Update" 'magit-module-worktree-p)
(magit-submodule-arguments
"--force" "--remote" "--recursive" "--checkout" "--rebase" "--merge"
"--no-fetch")))
(magit-with-toplevel
(magit-run-git-async "submodule" "update" args "--" modules)))
;;;###autoload (autoload 'magit-submodule-synchronize "magit-submodule" nil t)
(transient-define-suffix magit-submodule-synchronize (modules args)
"Synchronize url configuration of MODULES.
With a prefix argument act on all suitable modules. Otherwise,
if the region selects modules, then act on those. Otherwise, if
there is a module at point, then act on that. Otherwise read a
single module from the user."
:class 'magit--git-submodule-suffix
:description "Synchronize git submodule sync [--recursive]"
(interactive
(list (magit-module-confirm "Synchronize" 'magit-module-worktree-p)
(magit-submodule-arguments "--recursive")))
(magit-with-toplevel
(magit-run-git-async "submodule" "sync" args "--" modules)))
;;;###autoload (autoload 'magit-submodule-unpopulate "magit-submodule" nil t)
(transient-define-suffix magit-submodule-unpopulate (modules args)
"Remove working directories of MODULES.
With a prefix argument act on all suitable modules. Otherwise,
if the region selects modules, then act on those. Otherwise, if
there is a module at point, then act on that. Otherwise read a
single module from the user."
;; Even though a package is "uninitialized" (it has no worktree)
;; the super-projects $GIT_DIR/config may never-the-less set the
;; module's url. This may happen if you `deinit' and then `init'
;; to register (NOT initialize). Because the purpose of `deinit'
;; is to remove the working directory AND to remove the url, this
;; command does not limit itself to modules that have no working
;; directory.
:class 'magit--git-submodule-suffix
:description "Unpopulate git submodule deinit [--force]"
(interactive
(list (magit-module-confirm "Unpopulate")
(magit-submodule-arguments "--force")))
(magit-with-toplevel
(magit-run-git-async "submodule" "deinit" args "--" modules)))
;;;###autoload
(defun magit-submodule-remove (modules args trash-gitdirs)
"Unregister MODULES and remove their working directories.
For safety reasons, do not remove the gitdirs and if a module has
uncommitted changes, then do not remove it at all. If a module's
gitdir is located inside the working directory, then move it into
the gitdir of the superproject first.
With the \"--force\" argument offer to remove dirty working
directories and with a prefix argument offer to delete gitdirs.
Both actions are very dangerous and have to be confirmed. There
are additional safety precautions in place, so you might be able
to recover from making a mistake here, but don't count on it."
(interactive
(list (if-let ((modules (magit-region-values 'magit-module-section t)))
(magit-confirm 'remove-modules nil "Remove %i modules" nil modules)
(list (magit-read-module-path "Remove module")))
(magit-submodule-arguments "--force")
current-prefix-arg))
(when (magit-git-version< "2.12.0")
(error "This command requires Git v2.12.0"))
(when magit-submodule-remove-trash-gitdirs
(setq trash-gitdirs t))
(magit-with-toplevel
(when-let
((modified
(-filter (lambda (module)
(let ((default-directory (file-name-as-directory
(expand-file-name module))))
(and (cddr (directory-files default-directory))
(magit-anything-modified-p))))
modules)))
(if (member "--force" args)
(if (magit-confirm 'remove-dirty-modules
"Remove dirty module %s"
"Remove %i dirty modules"
t modified)
(dolist (module modified)
(let ((default-directory (file-name-as-directory
(expand-file-name module))))
(magit-git "stash" "push"
"-m" "backup before removal of this module")))
(setq modules (cl-set-difference modules modified :test #'equal)))
(if (cdr modified)
(message "Omitting %s modules with uncommitted changes: %s"
(length modified)
(mapconcat #'identity modified ", "))
(message "Omitting module %s, it has uncommitted changes"
(car modified)))
(setq modules (cl-set-difference modules modified :test #'equal))))
(when modules
(let ((alist
(and trash-gitdirs
(--map (split-string it "\0")
(magit-git-lines "submodule" "foreach" "-q"
"printf \"$sm_path\\0$name\n\"")))))
(magit-git "submodule" "absorbgitdirs" "--" modules)
(magit-git "submodule" "deinit" args "--" modules)
(magit-git "rm" args "--" modules)
(when (and trash-gitdirs
(magit-confirm 'trash-module-gitdirs
"Trash gitdir of module %s"
"Trash gitdirs of %i modules"
t modules))
(dolist (module modules)
(if-let ((name (cadr (assoc module alist))))
;; Disregard if `magit-delete-by-moving-to-trash'
;; is nil. Not doing so would be too dangerous.
(delete-directory (magit-git-dir
(convert-standard-filename
(concat "modules/" name)))
t t)
(error "BUG: Weird module name and/or path for %s" module)))))
(magit-refresh))))
;;; Sections
;;;###autoload
(defun magit-insert-modules ()
"Insert submodule sections.
Hook `magit-module-sections-hook' controls which module sections
are inserted, and option `magit-module-sections-nested' controls
whether they are wrapped in an additional section."
(when-let ((modules (magit-list-module-paths)))
(if magit-module-sections-nested
(magit-insert-section (modules nil t)
(magit-insert-heading
(format "%s (%s)"
(propertize "Modules"
'font-lock-face 'magit-section-heading)
(length modules)))
(magit-insert-section-body
(magit--insert-modules)))
(magit--insert-modules))))
(defun magit--insert-modules (&optional _section)
(magit-run-section-hook 'magit-module-sections-hook))
;;;###autoload
(defun magit-insert-modules-overview ()
"Insert sections for all modules.
For each section insert the path and the output of `git describe --tags',
or, failing that, the abbreviated HEAD commit hash."
(when-let ((modules (magit-list-module-paths)))
(magit-insert-section (modules nil t)
(magit-insert-heading
(format "%s (%s)"
(propertize "Modules overview"
'font-lock-face 'magit-section-heading)
(length modules)))
(magit-insert-section-body
(magit--insert-modules-overview)))))
(defvar magit-modules-overview-align-numbers t)
(defun magit--insert-modules-overview (&optional _section)
(magit-with-toplevel
(let* ((modules (magit-list-module-paths))
(path-format (format "%%-%is "
(min (apply #'max (mapcar #'length modules))
(/ (window-width) 2))))
(branch-format (format "%%-%is " (min 25 (/ (window-width) 3)))))
(dolist (module modules)
(let ((default-directory
(expand-file-name (file-name-as-directory module))))
(magit-insert-section (magit-module-section module t)
(insert (propertize (format path-format module)
'font-lock-face 'magit-diff-file-heading))
(if (not (file-exists-p ".git"))
(insert "(unpopulated)")
(insert (format
branch-format
(--if-let (magit-get-current-branch)
(propertize it 'font-lock-face 'magit-branch-local)
(propertize "(detached)" 'font-lock-face 'warning))))
(--if-let (magit-git-string "describe" "--tags")
(progn (when (and magit-modules-overview-align-numbers
(string-match-p "\\`[0-9]" it))
(insert ?\s))
(insert (propertize it 'font-lock-face 'magit-tag)))
(--when-let (magit-rev-format "%h")
(insert (propertize it 'font-lock-face 'magit-hash)))))
(insert ?\n))))))
(insert ?\n))
(defvar magit-modules-section-map
(let ((map (make-sparse-keymap)))
(magit-menu-set map [remap magit-visit-thing]
#'magit-list-submodules "List %t")
map)
"Keymap for `modules' sections.")
(defvar magit-module-section-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-j") #'magit-submodule-visit)
(define-key map [C-return] #'magit-submodule-visit)
(magit-menu-set map [magit-visit-thing]
#'magit-submodule-visit "Visit %s")
(magit-menu-set map [magit-stage-file]
#'magit-stage "Stage %T"
'(:visible (eq (magit-diff-type) 'unstaged)))
(magit-menu-set map [magit-unstage-file]
#'magit-unstage "Unstage %T"
'(:visible (eq (magit-diff-type) 'staged)))
(define-key-after map [separator-magit-submodule] menu-bar-separator)
(magit-menu-set map [magit-submodule] #'magit-submodule "Module commands...")
map)
"Keymap for `module' sections.")
(defun magit-submodule-visit (module &optional other-window)
"Visit MODULE by calling `magit-status' on it.
Offer to initialize MODULE if it's not checked out yet.
With a prefix argument, visit in another window."
(interactive (list (or (magit-section-value-if 'module)
(magit-read-module-path "Visit module"))
current-prefix-arg))
(magit-with-toplevel
(let ((path (expand-file-name module)))
(cond
((file-exists-p (expand-file-name ".git" module))
(magit-diff-visit-directory path other-window))
((y-or-n-p (format "Initialize submodule '%s' first?" module))
(magit-run-git-async "submodule" "update" "--init" "--" module)
(set-process-sentinel
magit-this-process
(lambda (process event)
(let ((magit-process-raise-error t))
(magit-process-sentinel process event))
(when (and (eq (process-status process) 'exit)
(= (process-exit-status process) 0))
(magit-diff-visit-directory path other-window)))))
((file-exists-p path)
(dired-jump other-window (concat path "/.")))))))
;;;###autoload
(defun magit-insert-modules-unpulled-from-upstream ()
"Insert sections for modules that haven't been pulled from the upstream.
These sections can be expanded to show the respective commits."
(magit--insert-modules-logs "Modules unpulled from @{upstream}"
'modules-unpulled-from-upstream
"HEAD..@{upstream}"))
;;;###autoload
(defun magit-insert-modules-unpulled-from-pushremote ()
"Insert sections for modules that haven't been pulled from the push-remote.
These sections can be expanded to show the respective commits."
(magit--insert-modules-logs "Modules unpulled from @{push}"
'modules-unpulled-from-pushremote
"HEAD..@{push}"))
;;;###autoload
(defun magit-insert-modules-unpushed-to-upstream ()
"Insert sections for modules that haven't been pushed to the upstream.
These sections can be expanded to show the respective commits."
(magit--insert-modules-logs "Modules unmerged into @{upstream}"
'modules-unpushed-to-upstream
"@{upstream}..HEAD"))
;;;###autoload
(defun magit-insert-modules-unpushed-to-pushremote ()
"Insert sections for modules that haven't been pushed to the push-remote.
These sections can be expanded to show the respective commits."
(magit--insert-modules-logs "Modules unpushed to @{push}"
'modules-unpushed-to-pushremote
"@{push}..HEAD"))
(defun magit--insert-modules-logs (heading type range)
"For internal use, don't add to a hook."
(unless (magit-ignore-submodules-p)
(when-let ((modules (magit-list-module-paths)))
(magit-insert-section section ((eval type) nil t)
(string-match "\\`\\(.+\\) \\([^ ]+\\)\\'" heading)
(magit-insert-heading
(propertize (match-string 1 heading)
'font-lock-face 'magit-section-heading)
" "
(propertize (match-string 2 heading)
'font-lock-face 'magit-branch-remote)
":")
(magit-with-toplevel
(dolist (module modules)
(when (magit-module-worktree-p module)
(let ((default-directory
(expand-file-name (file-name-as-directory module))))
(when (magit-file-accessible-directory-p default-directory)
(magit-insert-section sec (magit-module-section module t)
(magit-insert-heading
(propertize module
'font-lock-face 'magit-diff-file-heading)
":")
(oset sec range range)
(magit-git-wash
(apply-partially #'magit-log-wash-log 'module)
"-c" "push.default=current" "log" "--oneline" range)
(when (> (point)
(oref sec content))
(delete-char -1))))))))
(if (> (point)
(oref section content))
(insert ?\n)
(magit-cancel-section))))))
;;; List
;;;###autoload
(defun magit-list-submodules ()
"Display a list of the current repository's submodules."
(interactive)
(magit-submodule-list-setup magit-submodule-list-columns))
(defvar magit-submodule-list-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map magit-repolist-mode-map)
map)
"Local keymap for Magit-Submodule-List mode buffers.")
(define-derived-mode magit-submodule-list-mode tabulated-list-mode "Modules"
"Major mode for browsing a list of Git submodules."
:group 'magit-repolist-mode
(setq-local x-stretch-cursor nil)
(setq tabulated-list-padding 0)
(add-hook 'tabulated-list-revert-hook #'magit-submodule-list-refresh nil t)
(setq imenu-prev-index-position-function
#'magit-repolist--imenu-prev-index-position)
(setq imenu-extract-index-name-function #'tabulated-list-get-id))
(defvar-local magit-submodule-list-predicate nil)
(defun magit-submodule-list-setup (columns &optional predicate)
(magit-display-buffer
(or (magit-get-mode-buffer 'magit-submodule-list-mode)
(magit-with-toplevel
(magit-generate-new-buffer 'magit-submodule-list-mode))))
(magit-submodule-list-mode)
(setq-local magit-repolist-columns columns)
(setq-local magit-repolist-sort-key magit-submodule-list-sort-key)
(setq-local magit-submodule-list-predicate predicate)
(magit-repolist-setup-1)
(magit-submodule-list-refresh))
(defun magit-submodule-list-refresh ()
(setq tabulated-list-entries
(-keep (lambda (module)
(let ((default-directory
(expand-file-name (file-name-as-directory module))))
(and (file-exists-p ".git")
(or (not magit-submodule-list-predicate)
(funcall magit-submodule-list-predicate module))
(list module
(vconcat
(mapcar (pcase-lambda (`(,title ,width ,fn ,props))
(or (funcall fn `((:path ,module)
(:title ,title)
(:width ,width)
,@props))
""))
magit-repolist-columns))))))
(magit-list-module-paths)))
(message "Listing submodules...")
(tabulated-list-init-header)
(tabulated-list-print t)
(message "Listing submodules...done"))
(defun magit-modulelist-column-path (spec)
"Insert the relative path of the submodule."
(cadr (assq :path spec)))
;;; Utilities
(defun magit-submodule--maybe-reuse-gitdir (name path)
(let ((gitdir
(magit-git-dir (convert-standard-filename (concat "modules/" name)))))
(when (and (file-exists-p gitdir)
(not (file-exists-p path)))
(pcase (read-char-choice
(concat
gitdir " already exists.\n"
"Type [u] to use the existing gitdir and create the working tree\n"
" [r] to rename the existing gitdir and clone again\n"
" [t] to trash the existing gitdir and clone again\n"
" [C-g] to abort ")
'(?u ?r ?t))
(?u (magit-submodule--restore-worktree (expand-file-name path) gitdir))
(?r (rename-file gitdir (concat gitdir "-"
(format-time-string "%F-%T"))))
(?t (delete-directory gitdir t t))))))
(defun magit-submodule--restore-worktree (worktree gitdir)
(make-directory worktree t)
(with-temp-file (expand-file-name ".git" worktree)
(insert "gitdir: " (file-relative-name gitdir worktree) "\n"))
(let ((default-directory worktree))
(magit-call-git "reset" "--hard" "HEAD" "--")))
;;; _
(provide 'magit-submodule)
;;; magit-submodule.el ends here

181
code/elpa/magit-20220425.1153/magit-subtree.el Normal file
View file

@ -0,0 +1,181 @@
;;; magit-subtree.el --- Subtree support for Magit -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
(require 'magit)
;;; Commands
;;;###autoload (autoload 'magit-subtree "magit-subtree" nil t)
(transient-define-prefix magit-subtree ()
"Import or export subtrees."
:man-page "git-subtree"
["Actions"
("i" "Import" magit-subtree-import)
("e" "Export" magit-subtree-export)])
;;;###autoload (autoload 'magit-subtree-import "magit-subtree" nil t)
(transient-define-prefix magit-subtree-import ()
"Import subtrees."
:man-page "git-subtree"
["Arguments"
(magit-subtree:--prefix)
(magit-subtree:--message)
("-s" "Squash" "--squash")]
["Actions"
[("a" "Add" magit-subtree-add)
("c" "Add commit" magit-subtree-add-commit)]
[("m" "Merge" magit-subtree-merge)
("f" "Pull" magit-subtree-pull)]])
;;;###autoload (autoload 'magit-subtree-export "magit-subtree" nil t)
(transient-define-prefix magit-subtree-export ()
"Export subtrees."
:man-page "git-subtree"
["Arguments"
(magit-subtree:--prefix)
(magit-subtree:--annotate)
(magit-subtree:--branch)
(magit-subtree:--onto)
("-i" "Ignore joins" "--ignore-joins")
("-j" "Rejoin" "--rejoin")]
["Actions"
("p" "Push" magit-subtree-push)
("s" "Split" magit-subtree-split)])
(transient-define-argument magit-subtree:--prefix ()
:description "Prefix"
:class 'transient-option
:shortarg "-P"
:argument "--prefix="
:reader #'magit-subtree-read-prefix)
(defun magit-subtree-read-prefix (prompt &optional default _history)
(let* ((insert-default-directory nil)
(topdir (magit-toplevel))
(prefix (read-directory-name (concat prompt ": ") topdir default)))
(if (file-name-absolute-p prefix)
;; At least `ido-mode's variant is not compatible.
(if (string-prefix-p topdir prefix)
(file-relative-name prefix topdir)
(user-error "%s isn't inside the repository at %s" prefix topdir))
prefix)))
(transient-define-argument magit-subtree:--message ()
:description "Message"
:class 'transient-option
:shortarg "-m"
:argument "--message=")
(transient-define-argument magit-subtree:--annotate ()
:description "Annotate"
:class 'transient-option
:key "-a"
:argument "--annotate=")
(transient-define-argument magit-subtree:--branch ()
:description "Branch"
:class 'transient-option
:shortarg "-b"
:argument "--branch=")
(transient-define-argument magit-subtree:--onto ()
:description "Onto"
:class 'transient-option
:key "-o"
:argument "--onto="
:reader #'magit-transient-read-revision)
(defun magit-subtree-prefix (transient prompt)
(--if-let (--first (string-prefix-p "--prefix=" it)
(transient-args transient))
(substring it 9)
(magit-subtree-read-prefix prompt)))
(defun magit-subtree-arguments (transient)
(--remove (string-prefix-p "--prefix=" it)
(transient-args transient)))
(defun magit-git-subtree (subcmd prefix &rest args)
(magit-run-git-async "subtree" subcmd (concat "--prefix=" prefix) args))
;;;###autoload
(defun magit-subtree-add (prefix repository ref args)
"Add REF from REPOSITORY as a new subtree at PREFIX."
(interactive
(cons (magit-subtree-prefix 'magit-subtree-import "Add subtree")
(let ((remote (magit-read-remote-or-url "From repository")))
(list remote
(magit-read-refspec "Ref" remote)
(magit-subtree-arguments 'magit-subtree-import)))))
(magit-git-subtree "add" prefix args repository ref))
;;;###autoload
(defun magit-subtree-add-commit (prefix commit args)
"Add COMMIT as a new subtree at PREFIX."
(interactive
(list (magit-subtree-prefix 'magit-subtree-import "Add subtree")
(magit-read-string-ns "Commit")
(magit-subtree-arguments 'magit-subtree-import)))
(magit-git-subtree "add" prefix args commit))
;;;###autoload
(defun magit-subtree-merge (prefix commit args)
"Merge COMMIT into the PREFIX subtree."
(interactive
(list (magit-subtree-prefix 'magit-subtree-import "Merge into subtree")
(magit-read-string-ns "Commit")
(magit-subtree-arguments 'magit-subtree-import)))
(magit-git-subtree "merge" prefix args commit))
;;;###autoload
(defun magit-subtree-pull (prefix repository ref args)
"Pull REF from REPOSITORY into the PREFIX subtree."
(interactive
(cons (magit-subtree-prefix 'magit-subtree-import "Pull into subtree")
(let ((remote (magit-read-remote-or-url "From repository")))
(list remote
(magit-read-refspec "Ref" remote)
(magit-subtree-arguments 'magit-subtree-import)))))
(magit-git-subtree "pull" prefix args repository ref))
;;;###autoload
(defun magit-subtree-push (prefix repository ref args)
"Extract the history of the subtree PREFIX and push it to REF on REPOSITORY."
(interactive (list (magit-subtree-prefix 'magit-subtree-export "Push subtree")
(magit-read-remote-or-url "To repository")
(magit-read-string-ns "To reference")
(magit-subtree-arguments 'magit-subtree-export)))
(magit-git-subtree "push" prefix args repository ref))
;;;###autoload
(defun magit-subtree-split (prefix commit args)
"Extract the history of the subtree PREFIX."
(interactive (list (magit-subtree-prefix 'magit-subtree-export "Split subtree")
(magit-read-string-ns "Commit")
(magit-subtree-arguments 'magit-subtree-export)))
(magit-git-subtree "split" prefix args commit))
;;; _
(provide 'magit-subtree)
;;; magit-subtree.el ends here

236
code/elpa/magit-20220425.1153/magit-tag.el Normal file
View file

@ -0,0 +1,236 @@
;;; magit-tag.el --- Tag functionality -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library implements tag commands.
;;; Code:
(require 'magit)
;; For `magit-tag-delete'.
(defvar helm-comp-read-use-marked)
;;;###autoload (autoload 'magit-tag "magit" nil t)
(transient-define-prefix magit-tag ()
"Create or delete a tag."
:man-page "git-tag"
["Arguments"
("-f" "Force" ("-f" "--force"))
("-a" "Annotate" ("-a" "--annotate"))
("-s" "Sign" ("-s" "--sign"))
(magit-tag:--local-user)]
[["Create"
("t" "tag" magit-tag-create)
("r" "release" magit-tag-release)]
["Do"
("k" "delete" magit-tag-delete)
("p" "prune" magit-tag-prune)]])
(defun magit-tag-arguments ()
(transient-args 'magit-tag))
(transient-define-argument magit-tag:--local-user ()
:description "Sign as"
:class 'transient-option
:shortarg "-u"
:argument "--local-user="
:reader #'magit-read-gpg-signing-key
:history-key 'magit:--gpg-sign)
;;;###autoload
(defun magit-tag-create (name rev &optional args)
"Create a new tag with the given NAME at REV.
With a prefix argument annotate the tag.
\n(git tag [--annotate] NAME REV)"
(interactive (list (magit-read-tag "Tag name")
(magit-read-branch-or-commit "Place tag on")
(let ((args (magit-tag-arguments)))
(when current-prefix-arg
(cl-pushnew "--annotate" args))
args)))
(magit-run-git-with-editor "tag" args name rev))
;;;###autoload
(defun magit-tag-delete (tags)
"Delete one or more tags.
If the region marks multiple tags (and nothing else), then offer
to delete those, otherwise prompt for a single tag to be deleted,
defaulting to the tag at point.
\n(git tag -d TAGS)"
(interactive (list (--if-let (magit-region-values 'tag)
(magit-confirm t nil "Delete %i tags" nil it)
(let ((helm-comp-read-use-marked t))
(magit-read-tag "Delete tag" t)))))
(magit-run-git "tag" "-d" tags))
;;;###autoload
(defun magit-tag-prune (tags remote-tags remote)
"Offer to delete tags missing locally from REMOTE, and vice versa."
(interactive
(let* ((remote (magit-read-remote "Prune tags using remote"))
(tags (magit-list-tags))
(rtags (prog2 (message "Determining remote tags...")
(magit-remote-list-tags remote)
(message "Determining remote tags...done")))
(ltags (-difference tags rtags))
(rtags (-difference rtags tags)))
(unless (or ltags rtags)
(message "Same tags exist locally and remotely"))
(unless (magit-confirm t
"Delete %s locally"
"Delete %i tags locally"
'noabort ltags)
(setq ltags nil))
(unless (magit-confirm t
"Delete %s from remote"
"Delete %i tags from remote"
'noabort rtags)
(setq rtags nil))
(list ltags rtags remote)))
(when tags
(magit-call-git "tag" "-d" tags))
(when remote-tags
(magit-run-git-async "push" remote (--map (concat ":" it) remote-tags))))
(defvar magit-tag-version-regexp-alist
'(("^[-._+ ]?snapshot\\.?$" . -4)
("^[-._+]$" . -4)
("^[-._+ ]?\\(cvs\\|git\\|bzr\\|svn\\|hg\\|darcs\\)\\.?$" . -4)
("^[-._+ ]?unknown\\.?$" . -4)
("^[-._+ ]?alpha\\.?$" . -3)
("^[-._+ ]?beta\\.?$" . -2)
("^[-._+ ]?\\(pre\\|rc\\)\\.?$" . -1))
"Overrides `version-regexp-alist' for `magit-tag-release'.
See also `magit-release-tag-regexp'.")
(defvar magit-release-tag-regexp "\\`\
\\(?1:\\(?:v\\(?:ersion\\)?\\|r\\(?:elease\\)?\\)?[-_]?\\)?\
\\(?2:[0-9]+\\(?:\\.[0-9]+\\)*\
\\(?:-[a-zA-Z0-9-]+\\(?:\\.[a-zA-Z0-9-]+\\)*\\)?\\)\\'"
"Regexp used by `magit-tag-release' to parse release tags.
The first submatch must match the prefix, if any. The second
submatch must match the version string.
If this matches versions that are not dot separated numbers,
then `magit-tag-version-regexp-alist' has to contain entries
for the separators allowed here.")
(defvar magit-release-commit-regexp "\\`Release version \\(.+\\)\\'"
"Regexp used by `magit-tag-release' to parse release commit messages.
The first submatch must match the version string.")
;;;###autoload
(defun magit-tag-release (tag msg &optional args)
"Create a release tag for `HEAD'.
Assume that release tags match `magit-release-tag-regexp'.
If `HEAD's message matches `magit-release-commit-regexp', then
base the tag on the version string specified by that. Otherwise
prompt for the name of the new tag using the highest existing
tag as initial input and leaving it to the user to increment the
desired part of the version string.
If `--annotate' is enabled, then prompt for the message of the
new tag. Base the proposed tag message on the message of the
highest tag, provided that that contains the corresponding
version string and substituting the new version string for that.
Otherwise propose something like \"Foo-Bar 1.2.3\", given, for
example, a TAG \"v1.2.3\" and a repository located at something
like \"/path/to/foo-bar\"."
(interactive
(save-match-data
(pcase-let*
((`(,pver ,ptag ,pmsg) (car (magit--list-releases)))
(msg (magit-rev-format "%s"))
(ver (and (string-match magit-release-commit-regexp msg)
(match-string 1 msg)))
(_ (and (not ver)
(require (quote sisyphus) nil t)
(string-match magit-release-commit-regexp
(magit-rev-format "%s" ptag))
(user-error "Use `sisyphus-create-release' first")))
(tag (if ver
(concat (and (string-match magit-release-tag-regexp ptag)
(match-string 1 ptag))
ver)
(read-string
(format "Create release tag (previous was %s): " ptag)
ptag)))
(ver (and (string-match magit-release-tag-regexp tag)
(match-string 2 tag)))
(args (magit-tag-arguments)))
(list tag
(and (member "--annotate" args)
(read-string
(format "Message for %S: " tag)
(cond ((and pver (string-match (regexp-quote pver) pmsg))
(replace-match ver t t pmsg))
((and ptag (string-match (regexp-quote ptag) pmsg))
(replace-match tag t t pmsg))
(t (format "%s %s"
(capitalize
(file-name-nondirectory
(directory-file-name (magit-toplevel))))
ver)))))
args))))
(magit-run-git-async "tag" args (and msg (list "-m" msg)) tag)
(set-process-sentinel
magit-this-process
(lambda (process event)
(when (memq (process-status process) '(exit signal))
(magit-process-sentinel process event)
(magit-refs-setup-buffer "HEAD" (magit-show-refs-arguments))))))
(defun magit--list-releases ()
"Return a list of releases.
The list is ordered, beginning with the highest release.
Each release element has the form (VERSION TAG MESSAGE).
`magit-release-tag-regexp' is used to determine whether
a tag qualifies as a release tag."
(save-match-data
(mapcar
#'cdr
(nreverse
(cl-sort (cl-mapcan
(lambda (line)
(and (string-match " +" line)
(let ((tag (substring line 0 (match-beginning 0)))
(msg (substring line (match-end 0))))
(and (string-match magit-release-tag-regexp tag)
(let ((ver (match-string 2 tag))
(version-regexp-alist
magit-tag-version-regexp-alist))
(list (list (version-to-list ver)
ver tag msg)))))))
;; Cannot rely on "--sort=-version:refname" because
;; that gets confused if the version prefix has changed.
(magit-git-lines "tag" "-n"))
;; The inverse of this function does not exist.
#'version-list-< :key #'car)))))
;;; _
(provide 'magit-tag)
;;; magit-tag.el ends here

220
code/elpa/magit-20220425.1153/magit-transient.el Normal file
View file

@ -0,0 +1,220 @@
;;; magit-transient.el --- Support for transients -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library implements Magit-specific prefix and suffix classes,
;; and their methods.
;;; Code:
(require 'magit-git)
(require 'magit-mode)
(require 'magit-process)
(require 'transient)
;;; Classes
(defclass magit--git-variable (transient-variable)
((scope :initarg :scope)
(global :initarg :global :initform nil)))
(defclass magit--git-variable:choices (magit--git-variable)
((choices :initarg :choices)
(fallback :initarg :fallback :initform nil)
(default :initarg :default :initform nil)))
(defclass magit--git-variable:boolean (magit--git-variable:choices)
((choices :initarg :choices :initform '("true" "false"))))
(defclass magit--git-variable:urls (magit--git-variable)
((seturl-arg :initarg :seturl-arg :initform nil)))
;;; Methods
;;;; Init
(cl-defmethod transient-init-scope ((obj magit--git-variable))
(oset obj scope
(cond (transient--prefix
(oref transient--prefix scope))
((slot-boundp obj 'scope)
(funcall (oref obj scope) obj)))))
(cl-defmethod transient-init-value ((obj magit--git-variable))
(let ((variable (format (oref obj variable)
(oref obj scope)))
(arg (if (oref obj global) "--global" "--local")))
(oset obj variable variable)
(oset obj value
(cond ((oref obj multi-value)
(magit-get-all arg variable))
(t
(magit-get arg variable))))))
(cl-defmethod transient-init-value ((obj magit--git-variable:boolean))
(let ((variable (format (oref obj variable)
(oref obj scope)))
(arg (if (oref obj global) "--global" "--local")))
(oset obj variable variable)
(oset obj value (if (magit-get-boolean arg variable) "true" "false"))))
;;;; Read
(cl-defmethod transient-infix-read :around ((obj magit--git-variable:urls))
(transient--with-emergency-exit
(transient--with-suspended-override
(mapcar (lambda (url)
(if (string-prefix-p "~" url)
(expand-file-name url)
url))
(cl-call-next-method obj)))))
(cl-defmethod transient-infix-read ((obj magit--git-variable:choices))
(let ((choices (oref obj choices)))
(when (functionp choices)
(setq choices (funcall choices)))
(if-let ((value (oref obj value)))
(cadr (member value choices))
(car choices))))
;;;; Readers
(defun magit-transient-read-person (prompt initial-input history)
(magit-completing-read
prompt
(mapcar (lambda (line)
(save-excursion
(and (string-match "\\`[\s\t]+[0-9]+\t" line)
(list (substring line (match-end 0))))))
(magit-git-lines "shortlog" "-n" "-s" "-e" "HEAD"))
nil nil initial-input history))
(defun magit-transient-read-revision (prompt initial-input history)
(or (magit-completing-read prompt (cons "HEAD" (magit-list-refnames))
nil nil initial-input history
(or (magit-branch-or-commit-at-point)
(magit-get-current-branch)))
(user-error "Nothing selected")))
;;;; Set
(cl-defmethod transient-infix-set ((obj magit--git-variable) value)
(let ((variable (oref obj variable))
(arg (if (oref obj global) "--global" "--local")))
(oset obj value value)
(if (oref obj multi-value)
(magit-set-all value arg variable)
(magit-set value arg variable))
(magit-refresh)
(unless (or value transient--prefix)
(message "Unset %s" variable))))
(cl-defmethod transient-infix-set ((obj magit--git-variable:urls) values)
(let ((previous (oref obj value))
(seturl (oref obj seturl-arg))
(remote (oref transient--prefix scope)))
(oset obj value values)
(dolist (v (-difference values previous))
(magit-call-git "remote" "set-url" seturl "--add" remote v))
(dolist (v (-difference previous values))
(magit-call-git "remote" "set-url" seturl "--delete" remote
(concat "^" (regexp-quote v) "$")))
(magit-refresh)))
;;;; Draw
(cl-defmethod transient-format-description ((obj magit--git-variable))
(or (oref obj description)
(oref obj variable)))
(cl-defmethod transient-format-value ((obj magit--git-variable))
(if-let ((value (oref obj value)))
(if (oref obj multi-value)
(if (cdr value)
(mapconcat (lambda (v)
(concat "\n "
(propertize v 'face 'transient-value)))
value "")
(propertize (car value) 'face 'transient-value))
(propertize (car (split-string value "\n"))
'face 'transient-value))
(propertize "unset" 'face 'transient-inactive-value)))
(cl-defmethod transient-format-value ((obj magit--git-variable:choices))
(let* ((variable (oref obj variable))
(choices (oref obj choices))
(globalp (oref obj global))
(value nil)
(global (magit-git-string "config" "--global" variable))
(defaultp (oref obj default))
(default (if (functionp defaultp) (funcall defaultp obj) defaultp))
(fallback (oref obj fallback))
(fallback (and fallback
(and-let* ((val (magit-get fallback)))
(concat fallback ":" val)))))
(if (not globalp)
(setq value (magit-git-string "config" "--local" variable))
(setq value global)
(setq global nil))
(when (functionp choices)
(setq choices (funcall choices)))
(concat
(propertize "[" 'face 'transient-inactive-value)
(mapconcat (lambda (choice)
(propertize choice 'face (if (equal choice value)
(if (member choice choices)
'transient-value
'font-lock-warning-face)
'transient-inactive-value)))
(if (and value (not (member value choices)))
(cons value choices)
choices)
(propertize "|" 'face 'transient-inactive-value))
(and (or global fallback default)
(concat
(propertize "|" 'face 'transient-inactive-value)
(cond (global
(propertize (concat "global:" global)
'face (cond (value
'transient-inactive-value)
((member global choices)
'transient-value)
(t
'font-lock-warning-face))))
(fallback
(propertize fallback
'face (if value
'transient-inactive-value
'transient-value)))
(default
(propertize (if (functionp defaultp)
(concat "dwim:" default)
(concat "default:" default))
'face (if value
'transient-inactive-value
'transient-value))))))
(propertize "]" 'face 'transient-inactive-value))))
;;; _
(provide 'magit-transient)
;;; magit-transient.el ends here

453
code/elpa/magit-20220425.1153/magit-wip.el Normal file
View file

@ -0,0 +1,453 @@
;;; magit-wip.el --- Commit snapshots to work-in-progress refs -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library defines tree global modes which automatically commit
;; snapshots to branch-specific work-in-progress refs before and after
;; making changes, and two commands which can be used to do so on
;; demand.
;;; Code:
(require 'magit-core)
(require 'magit-log)
;;; Options
(defgroup magit-wip nil
"Automatically commit to work-in-progress refs."
:link '(info-link "(magit)Wip Modes")
:group 'magit-modes
:group 'magit-essentials)
(defgroup magit-wip-legacy nil
"It is better to not use these modes individually."
:link '(info-link "(magit)Legacy Wip Modes")
:group 'magit-wip)
(defcustom magit-wip-mode-lighter " Wip"
"Lighter for Magit-Wip mode."
:package-version '(magit . "2.90.0")
:group 'magit-wip
:type 'string)
(defcustom magit-wip-after-save-local-mode-lighter ""
"Lighter for Magit-Wip-After-Save-Local mode."
:package-version '(magit . "2.1.0")
:group 'magit-wip-legacy
:type 'string)
(defcustom magit-wip-after-apply-mode-lighter ""
"Lighter for Magit-Wip-After-Apply mode."
:package-version '(magit . "2.1.0")
:group 'magit-wip-legacy
:type 'string)
(defcustom magit-wip-before-change-mode-lighter ""
"Lighter for Magit-Wip-Before-Change mode."
:package-version '(magit . "2.1.0")
:group 'magit-wip-legacy
:type 'string)
(defcustom magit-wip-initial-backup-mode-lighter ""
"Lighter for Magit-Wip-Initial Backup mode."
:package-version '(magit . "2.1.0")
:group 'magit-wip-legacy
:type 'string)
(defcustom magit-wip-merge-branch nil
"Whether to merge the current branch into its wip ref.
If non-nil and the current branch has new commits, then it is
merged into the wip ref before creating a new wip commit. This
makes it easier to inspect wip history and the wip commits are
never garbage collected.
If nil and the current branch has new commits, then the wip ref
is reset to the tip of the branch before creating a new wip
commit. With this setting wip commits are eventually garbage
collected. This is currently the default."
:package-version '(magit . "2.90.0")
:group 'magit-wip
:type 'boolean)
(defcustom magit-wip-namespace "refs/wip/"
"Namespace used for work-in-progress refs.
The wip refs are named \"<namespace/>index/<branchref>\"
and \"<namespace/>wtree/<branchref>\". When snapshots
are created while the `HEAD' is detached then \"HEAD\"
is used as `branch-ref'."
:package-version '(magit . "2.1.0")
:group 'magit-wip
:type 'string)
;;; Modes
;;;###autoload
(define-minor-mode magit-wip-mode
"Save uncommitted changes to work-in-progress refs.
Whenever appropriate (i.e. when dataloss would be a possibility
otherwise) this mode causes uncommitted changes to be committed
to dedicated work-in-progress refs.
For historic reasons this mode is implemented on top of four
other `magit-wip-*' modes, which can also be used individually,
if you want finer control over when the wip refs are updated;
but that is discouraged."
:package-version '(magit . "2.90.0")
:lighter magit-wip-mode-lighter
:global t
(let ((arg (if magit-wip-mode 1 -1)))
(magit-wip-after-save-mode arg)
(magit-wip-after-apply-mode arg)
(magit-wip-before-change-mode arg)
(magit-wip-initial-backup-mode arg)))
(define-minor-mode magit-wip-after-save-local-mode
"After saving, also commit to a worktree work-in-progress ref.
After saving the current file-visiting buffer this mode also
commits the changes to the worktree work-in-progress ref for
the current branch.
This mode should be enabled globally by turning on the globalized
variant `magit-wip-after-save-mode'."
:package-version '(magit . "2.1.0")
:lighter magit-wip-after-save-local-mode-lighter
(if magit-wip-after-save-local-mode
(if (and buffer-file-name (magit-inside-worktree-p t))
(add-hook 'after-save-hook #'magit-wip-commit-buffer-file t t)
(setq magit-wip-after-save-local-mode nil)
(user-error "Need a worktree and a file"))
(remove-hook 'after-save-hook #'magit-wip-commit-buffer-file t)))
(defun magit-wip-after-save-local-mode-turn-on ()
(and buffer-file-name
(magit-inside-worktree-p t)
(magit-file-tracked-p buffer-file-name)
(magit-wip-after-save-local-mode)))
;;;###autoload
(define-globalized-minor-mode magit-wip-after-save-mode
magit-wip-after-save-local-mode magit-wip-after-save-local-mode-turn-on
:package-version '(magit . "2.1.0")
:group 'magit-wip)
(defun magit-wip-commit-buffer-file (&optional msg)
"Commit visited file to a worktree work-in-progress ref.
Also see `magit-wip-after-save-mode' which calls this function
automatically whenever a buffer visiting a tracked file is saved."
(interactive)
(--when-let (magit-wip-get-ref)
(magit-with-toplevel
(let ((file (file-relative-name buffer-file-name)))
(magit-wip-commit-worktree
it (list file)
(format (cond (msg)
((called-interactively-p 'any)
"wip-save %s after save")
(t
"autosave %s after save"))
file))))))
;;;###autoload
(define-minor-mode magit-wip-after-apply-mode
"Commit to work-in-progress refs.
After applying a change using any \"apply variant\"
command (apply, stage, unstage, discard, and reverse) commit the
affected files to the current wip refs. For each branch there
may be two wip refs; one contains snapshots of the files as found
in the worktree and the other contains snapshots of the entries
in the index."
:package-version '(magit . "2.1.0")
:group 'magit-wip
:lighter magit-wip-after-apply-mode-lighter
:global t)
(defun magit-wip-commit-after-apply (&optional files msg)
(when magit-wip-after-apply-mode
(magit-wip-commit files msg)))
;;;###autoload
(define-minor-mode magit-wip-before-change-mode
"Commit to work-in-progress refs before certain destructive changes.
Before invoking a revert command or an \"apply variant\"
command (apply, stage, unstage, discard, and reverse) commit the
affected tracked files to the current wip refs. For each branch
there may be two wip refs; one contains snapshots of the files
as found in the worktree and the other contains snapshots of the
entries in the index.
Only changes to files which could potentially be affected by the
command which is about to be called are committed."
:package-version '(magit . "2.1.0")
:group 'magit-wip
:lighter magit-wip-before-change-mode-lighter
:global t)
(defun magit-wip-commit-before-change (&optional files msg)
(when magit-wip-before-change-mode
(magit-with-toplevel
(magit-wip-commit files msg))))
(define-minor-mode magit-wip-initial-backup-mode
"Before saving a buffer for the first time, commit to a wip ref."
:package-version '(magit . "2.90.0")
:group 'magit-wip
:lighter magit-wip-initial-backup-mode-lighter
:global t
(if magit-wip-initial-backup-mode
(add-hook 'before-save-hook #'magit-wip-commit-initial-backup)
(remove-hook 'before-save-hook #'magit-wip-commit-initial-backup)))
(defun magit--any-wip-mode-enabled-p ()
"Return non-nil if any global wip mode is enabled."
(or magit-wip-mode
magit-wip-after-save-mode
magit-wip-after-apply-mode
magit-wip-before-change-mode
magit-wip-initial-backup-mode))
(defvar-local magit-wip-buffer-backed-up nil)
(put 'magit-wip-buffer-backed-up 'permanent-local t)
;;;###autoload
(defun magit-wip-commit-initial-backup ()
"Before saving, commit current file to a worktree wip ref.
The user has to add this function to `before-save-hook'.
Commit the current state of the visited file before saving the
current buffer to that file. This backs up the same version of
the file as `backup-buffer' would, but stores the backup in the
worktree wip ref, which is also used by the various Magit Wip
modes, instead of in a backup file as `backup-buffer' would.
This function ignores the variables that affect `backup-buffer'
and can be used along-side that function, which is recommended
because this function only backs up files that are tracked in
a Git repository."
(when (and (not magit-wip-buffer-backed-up)
buffer-file-name
(magit-inside-worktree-p t)
(magit-file-tracked-p buffer-file-name))
(let ((magit-save-repository-buffers nil))
(magit-wip-commit-buffer-file "autosave %s before save"))
(setq magit-wip-buffer-backed-up t)))
;;; Core
(defun magit-wip-commit (&optional files msg)
"Commit all tracked files to the work-in-progress refs.
Interactively, commit all changes to all tracked files using
a generic commit message. With a prefix-argument the commit
message is read in the minibuffer.
Non-interactively, only commit changes to FILES using MSG as
commit message."
(interactive (list nil (if current-prefix-arg
(magit-read-string "Wip commit message")
"wip-save tracked files")))
(--when-let (magit-wip-get-ref)
(magit-wip-commit-index it files msg)
(magit-wip-commit-worktree it files msg)))
(defun magit-wip-commit-index (ref files msg)
(let* ((wipref (magit--wip-index-ref ref))
(parent (magit-wip-get-parent ref wipref))
(tree (magit-git-string "write-tree")))
(magit-wip-update-wipref ref wipref tree parent files msg "index")))
(defun magit-wip-commit-worktree (ref files msg)
(when (or (not files)
;; `update-index' will either ignore (before Git v2.32.0)
;; or fail when passed directories (relevant for the
;; untracked files code paths).
(setq files (seq-remove #'file-directory-p files)))
(let* ((wipref (magit--wip-wtree-ref ref))
(parent (magit-wip-get-parent ref wipref))
(tree (magit-with-temp-index parent (list "--reset" "-i")
(if files
;; Note: `update-index' is used instead of `add'
;; because `add' will fail if a file is already
;; deleted in the temporary index.
(magit-call-git
"update-index" "--add" "--remove"
(and (magit-git-version>= "2.25.0")
"--ignore-skip-worktree-entries")
"--" files)
(magit-with-toplevel
(magit-call-git "add" "-u" ".")))
(magit-git-string "write-tree"))))
(magit-wip-update-wipref ref wipref tree parent files msg "worktree"))))
(defun magit-wip-update-wipref (ref wipref tree parent files msg start-msg)
(cond
((and (not (equal parent wipref))
(or (not magit-wip-merge-branch)
(not (magit-rev-verify wipref))))
(setq start-msg (concat "start autosaving " start-msg))
(magit-update-ref wipref start-msg
(magit-git-string "commit-tree" "--no-gpg-sign"
"-p" parent "-m" start-msg
(concat parent "^{tree}")))
(setq parent wipref))
((and magit-wip-merge-branch
(or (not (magit-rev-ancestor-p ref wipref))
(not (magit-rev-ancestor-p
(concat (magit-git-string "log" "--format=%H"
"-1" "--merges" wipref)
"^2")
ref))))
(setq start-msg (format "merge %s into %s" ref start-msg))
(magit-update-ref wipref start-msg
(magit-git-string "commit-tree" "--no-gpg-sign"
"-p" wipref "-p" ref
"-m" start-msg
(concat ref "^{tree}")))
(setq parent wipref)))
(when (magit-git-failure "diff-tree" "--quiet" parent tree "--" files)
(unless (and msg (not (= (aref msg 0) ?\s)))
(let ((len (length files)))
(setq msg (concat
(cond ((= len 0) "autosave tracked files")
((> len 1) (format "autosave %s files" len))
(t (concat "autosave "
(file-relative-name (car files)
(magit-toplevel)))))
msg))))
(magit-update-ref wipref msg
(magit-git-string "commit-tree" "--no-gpg-sign"
"-p" parent "-m" msg tree))))
(defun magit-wip-get-ref ()
(let ((ref (or (magit-git-string "symbolic-ref" "HEAD") "HEAD")))
(and (magit-rev-verify ref)
ref)))
(defun magit-wip-get-parent (ref wipref)
(if (and (magit-rev-verify wipref)
(equal (magit-git-string "merge-base" wipref ref)
(magit-rev-verify ref)))
wipref
ref))
(defun magit--wip-index-ref (&optional ref)
(magit--wip-ref "index/" ref))
(defun magit--wip-wtree-ref (&optional ref)
(magit--wip-ref "wtree/" ref))
(defun magit--wip-ref (namespace &optional ref)
(concat magit-wip-namespace namespace
(or (and ref (string-prefix-p "refs/" ref) ref)
(and-let* ((branch (and (not (equal ref "HEAD"))
(or ref (magit-get-current-branch)))))
(concat "refs/heads/" branch))
"HEAD")))
(defun magit-wip-maybe-add-commit-hook ()
(when (and magit-wip-merge-branch
(magit-wip-any-enabled-p))
(add-hook 'git-commit-post-finish-hook #'magit-wip-commit nil t)))
(defun magit-wip-any-enabled-p ()
(or magit-wip-mode
magit-wip-after-save-local-mode
magit-wip-after-save-mode
magit-wip-after-apply-mode
magit-wip-before-change-mode
magit-wip-initial-backup-mode))
;;; Log
(defun magit-wip-log-index (args files)
"Show log for the index wip ref of the current branch."
(interactive (magit-log-arguments))
(magit-log-setup-buffer (list (magit--wip-index-ref)) args files))
(defun magit-wip-log-worktree (args files)
"Show log for the worktree wip ref of the current branch."
(interactive (magit-log-arguments))
(magit-log-setup-buffer (list (magit--wip-wtree-ref)) args files))
(defun magit-wip-log-current (branch args files count)
"Show log for the current branch and its wip refs.
With a negative prefix argument only show the worktree wip ref.
The absolute numeric value of the prefix argument controls how
many \"branches\" of each wip ref are shown."
(interactive
(nconc (list (or (magit-get-current-branch) "HEAD"))
(magit-log-arguments)
(list (prefix-numeric-value current-prefix-arg))))
(magit-wip-log branch args files count))
(defun magit-wip-log (branch args files count)
"Show log for a branch and its wip refs.
With a negative prefix argument only show the worktree wip ref.
The absolute numeric value of the prefix argument controls how
many \"branches\" of each wip ref are shown."
(interactive
(nconc (list (magit-completing-read
"Log branch and its wip refs"
(-snoc (magit-list-local-branch-names) "HEAD")
nil t nil 'magit-revision-history
(or (magit-branch-at-point)
(magit-get-current-branch)
"HEAD")))
(magit-log-arguments)
(list (prefix-numeric-value current-prefix-arg))))
(magit-log-setup-buffer (nconc (list branch)
(magit-wip-log-get-tips
(magit--wip-wtree-ref branch)
(abs count))
(and (>= count 0)
(magit-wip-log-get-tips
(magit--wip-index-ref branch)
(abs count))))
args files))
(defun magit-wip-log-get-tips (wipref count)
(and-let* ((reflog (magit-git-lines "reflog" wipref)))
(let (tips)
(while (and reflog (> count 1))
;; "start autosaving ..." is the current message, but it used
;; to be "restart autosaving ...", and those messages may
;; still be around (e.g., if gc.reflogExpire is to "never").
(setq reflog (cl-member "^[^ ]+ [^:]+: \\(?:re\\)?start autosaving"
reflog :test #'string-match-p))
(when (and (cadr reflog)
(string-match "^[^ ]+ \\([^:]+\\)" (cadr reflog)))
(push (match-string 1 (cadr reflog)) tips))
(setq reflog (cddr reflog))
(cl-decf count))
(cons wipref (nreverse tips)))))
;;; _
(provide 'magit-wip)
;;; magit-wip.el ends here

191
code/elpa/magit-20220425.1153/magit-worktree.el Normal file
View file

@ -0,0 +1,191 @@
;;; magit-worktree.el --- Worktree support -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library implements support for `git-worktree'.
;;; Code:
(require 'magit)
;;; Options
(defcustom magit-worktree-read-directory-name-function #'read-directory-name
"Function used to read a directory for worktree commands.
This is called with one argument, the prompt, and can be used
to e.g. use a base directory other than `default-directory'.
Used by `magit-worktree-checkout' and `magit-worktree-branch'."
:package-version '(magit . "3.0.0")
:group 'magit-commands
:type 'function)
;;; Commands
;;;###autoload (autoload 'magit-worktree "magit-worktree" nil t)
(transient-define-prefix magit-worktree ()
"Act on a worktree."
:man-page "git-worktree"
[["Create new"
("b" "worktree" magit-worktree-checkout)
("c" "branch and worktree" magit-worktree-branch)]
["Commands"
("m" "Move worktree" magit-worktree-move)
("k" "Delete worktree" magit-worktree-delete)
("g" "Visit worktree" magit-worktree-status)]])
;;;###autoload
(defun magit-worktree-checkout (path branch)
"Checkout BRANCH in a new worktree at PATH."
(interactive
(let ((branch (magit-read-branch-or-commit "Checkout")))
(list (funcall magit-worktree-read-directory-name-function
(format "Checkout %s in new worktree: " branch))
branch)))
(magit-run-git "worktree" "add" (magit--expand-worktree path) branch)
(magit-diff-visit-directory path))
;;;###autoload
(defun magit-worktree-branch (path branch start-point &optional force)
"Create a new BRANCH and check it out in a new worktree at PATH."
(interactive
`(,(funcall magit-worktree-read-directory-name-function
"Create worktree: ")
,@(magit-branch-read-args "Create and checkout branch")
,current-prefix-arg))
(magit-run-git "worktree" "add" (if force "-B" "-b")
branch (magit--expand-worktree path) start-point)
(magit-diff-visit-directory path))
;;;###autoload
(defun magit-worktree-move (worktree path)
"Move WORKTREE to PATH."
(interactive
(list (magit-completing-read "Move worktree"
(cdr (magit-list-worktrees))
nil t nil nil
(magit-section-value-if 'worktree))
(funcall magit-worktree-read-directory-name-function
"Move worktree to: ")))
(if (file-directory-p (expand-file-name ".git" worktree))
(user-error "You may not move the main working tree")
(let ((preexisting-directory (file-directory-p path)))
(when (and (zerop (magit-call-git "worktree" "move" worktree
(magit--expand-worktree path)))
(not (file-exists-p default-directory))
(derived-mode-p 'magit-status-mode))
(kill-buffer)
(magit-diff-visit-directory
(if preexisting-directory
(concat (file-name-as-directory path)
(file-name-nondirectory worktree))
path)))
(magit-refresh))))
(defun magit-worktree-delete (worktree)
"Delete a worktree, defaulting to the worktree at point.
The primary worktree cannot be deleted."
(interactive
(list (magit-completing-read "Delete worktree"
(cdr (magit-list-worktrees))
nil t nil nil
(magit-section-value-if 'worktree))))
(if (file-directory-p (expand-file-name ".git" worktree))
(user-error "Deleting %s would delete the shared .git directory" worktree)
(let ((primary (file-name-as-directory (caar (magit-list-worktrees)))))
(magit-confirm-files (if magit-delete-by-moving-to-trash 'trash 'delete)
(list "worktree"))
(when (file-exists-p worktree)
(let ((delete-by-moving-to-trash magit-delete-by-moving-to-trash))
(delete-directory worktree t magit-delete-by-moving-to-trash)))
(if (file-exists-p default-directory)
(magit-run-git "worktree" "prune")
(let ((default-directory primary))
(magit-run-git "worktree" "prune"))
(when (derived-mode-p 'magit-status-mode)
(kill-buffer)
(magit-status-setup-buffer primary))))))
(defun magit-worktree-status (worktree)
"Show the status for the worktree at point.
If there is no worktree at point, then read one in the
minibuffer. If the worktree at point is the one whose
status is already being displayed in the current buffer,
then show it in Dired instead."
(interactive
(list (or (magit-section-value-if 'worktree)
(magit-completing-read
"Show status for worktree"
(cl-delete (directory-file-name (magit-toplevel))
(magit-list-worktrees)
:test #'equal :key #'car)))))
(magit-diff-visit-directory worktree))
(defun magit--expand-worktree (path)
(magit-convert-filename-for-git (expand-file-name path)))
;;; Sections
(defvar magit-worktree-section-map
(let ((map (make-sparse-keymap)))
(magit-menu-set map [magit-visit-thing] #'magit-worktree-status "Visit %s")
(magit-menu-set map [magit-delete-thing] #'magit-worktree-delete "Delete %m")
(define-key-after map [separator-magit-worktree] menu-bar-separator)
(magit-menu-set map [magit-worktree ] #'magit-worktree "Worktree commands...")
map)
"Keymap for `worktree' sections.")
(defun magit-insert-worktrees ()
"Insert sections for all worktrees.
If there is only one worktree, then insert nothing."
(let ((worktrees (magit-list-worktrees)))
(when (length> worktrees 1)
(magit-insert-section (worktrees)
(magit-insert-heading "Worktrees:")
(let* ((cols
(mapcar
(pcase-lambda (`(,path ,barep ,commit ,branch))
(cons (cond
(branch (propertize
branch 'font-lock-face
(if (equal branch (magit-get-current-branch))
'magit-branch-current
'magit-branch-local)))
(commit (propertize (magit-rev-abbrev commit)
'font-lock-face 'magit-hash))
(barep "(bare)"))
path))
worktrees))
(align (1+ (-max (--map (string-width (car it)) cols)))))
(pcase-dolist (`(,head . ,path) cols)
(magit-insert-section (worktree path)
(insert head)
(insert (make-string (- align (length head)) ?\s))
(insert (let ((r (file-relative-name path))
(a (abbreviate-file-name path)))
(if (< (string-width r) (string-width a)) r a)))
(insert ?\n))))
(insert ?\n)))))
;;; _
(provide 'magit-worktree)
;;; magit-worktree.el ends here

683
code/elpa/magit-20220425.1153/magit.el Normal file
View file

@ -0,0 +1,683 @@
;;; magit.el --- A Git porcelain inside Emacs -*- lexical-binding:t; coding:utf-8 -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Marius Vollmer <marius.vollmer@gmail.com>
;; Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; Kyle Meyer <kyle@kyleam.com>
;; Noam Postavsky <npostavs@users.sourceforge.net>
;; Former-Maintainers:
;; Nicolas Dudebout <nicolas.dudebout@gatech.edu>
;; Peter J. Weisberg <pj@irregularexpressions.net>
;; Phil Jackson <phil@shellarchive.co.uk>
;; Rémi Vanicat <vanicat@debian.org>
;; Yann Hodique <yann.hodique@gmail.com>
;; Homepage: https://github.com/magit/magit
;; Keywords: git tools vc
;; Package-Version: 3.3.0-git
;; Package-Requires: (
;; (emacs "25.1")
;; (compat "28.1.0.4")
;; (dash "2.19.1")
;; (git-commit "3.3.0")
;; (magit-section "3.3.0")
;; (transient "0.3.6")
;; (with-editor "3.0.5"))
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;; You should have received a copy of the AUTHORS.md file, which
;; lists all contributors. If not, see https://magit.vc/authors.
;;; Commentary:
;; Magit is a text-based Git user interface that puts an unmatched focus
;; on streamlining workflows. Commands are invoked using short mnemonic
;; key sequences that take the cursor’s position in the highly actionable
;; interface into account to provide context-sensitive behavior.
;; With Magit you can do nearly everything that you can do when using Git
;; on the command-line, but at greater speed and while taking advantage
;; of advanced features that previously seemed too daunting to use on a
;; daily basis. Many users will find that by using Magit they can become
;; more effective Git user.
;;; Code:
(require 'magit-core)
(require 'magit-diff)
(require 'magit-log)
(require 'magit-wip)
(require 'magit-apply)
(require 'magit-repos)
(require 'git-commit)
(require 'format-spec)
(require 'package nil t) ; used in `magit-version'
(require 'with-editor)
;;; Faces
(defface magit-header-line
'((t :inherit magit-section-heading))
"Face for the `header-line' in some Magit modes.
Note that some modes, such as `magit-log-select-mode', have their
own faces for the `header-line', or for parts of the
`header-line'."
:group 'magit-faces)
(defface magit-header-line-key
'((t :inherit font-lock-builtin-face))
"Face for keys in the `header-line'."
:group 'magit-faces)
(defface magit-dimmed
'((((class color) (background light)) :foreground "grey50")
(((class color) (background dark)) :foreground "grey50"))
"Face for text that shouldn't stand out."
:group 'magit-faces)
(defface magit-hash
'((((class color) (background light)) :foreground "grey60")
(((class color) (background dark)) :foreground "grey40"))
"Face for the commit object name in the log output."
:group 'magit-faces)
(defface magit-tag
'((((class color) (background light)) :foreground "Goldenrod4")
(((class color) (background dark)) :foreground "LightGoldenrod2"))
"Face for tag labels shown in log buffer."
:group 'magit-faces)
(defface magit-branch-remote
'((((class color) (background light)) :foreground "DarkOliveGreen4")
(((class color) (background dark)) :foreground "DarkSeaGreen2"))
"Face for remote branch head labels shown in log buffer."
:group 'magit-faces)
(defface magit-branch-remote-head
'((((supports (:box t))) :inherit magit-branch-remote :box t)
(t :inherit magit-branch-remote :inverse-video t))
"Face for current branch."
:group 'magit-faces)
(defface magit-branch-local
'((((class color) (background light)) :foreground "SkyBlue4")
(((class color) (background dark)) :foreground "LightSkyBlue1"))
"Face for local branches."
:group 'magit-faces)
(defface magit-branch-current
'((((supports (:box t))) :inherit magit-branch-local :box t)
(t :inherit magit-branch-local :inverse-video t))
"Face for current branch."
:group 'magit-faces)
(defface magit-branch-upstream
'((t :slant italic))
"Face for upstream branch.
This face is only used in logs and it gets combined
with `magit-branch-local', `magit-branch-remote'
and/or `magit-branch-remote-head'."
:group 'magit-faces)
(defface magit-branch-warning
'((t :inherit warning))
"Face for warning about (missing) branch."
:group 'magit-faces)
(defface magit-head
'((((class color) (background light)) :inherit magit-branch-local)
(((class color) (background dark)) :inherit magit-branch-local))
"Face for the symbolic ref `HEAD'."
:group 'magit-faces)
(defface magit-refname
'((((class color) (background light)) :foreground "grey30")
(((class color) (background dark)) :foreground "grey80"))
"Face for refnames without a dedicated face."
:group 'magit-faces)
(defface magit-refname-stash
'((t :inherit magit-refname))
"Face for stash refnames."
:group 'magit-faces)
(defface magit-refname-wip
'((t :inherit magit-refname))
"Face for wip refnames."
:group 'magit-faces)
(defface magit-refname-pullreq
'((t :inherit magit-refname))
"Face for pullreq refnames."
:group 'magit-faces)
(defface magit-keyword
'((t :inherit font-lock-string-face))
"Face for parts of commit messages inside brackets."
:group 'magit-faces)
(defface magit-keyword-squash
'((t :inherit font-lock-warning-face))
"Face for squash! and fixup! keywords in commit messages."
:group 'magit-faces)
(defface magit-signature-good
'((t :foreground "green"))
"Face for good signatures."
:group 'magit-faces)
(defface magit-signature-bad
'((t :foreground "red" :weight bold))
"Face for bad signatures."
:group 'magit-faces)
(defface magit-signature-untrusted
'((t :foreground "medium aquamarine"))
"Face for good untrusted signatures."
:group 'magit-faces)
(defface magit-signature-expired
'((t :foreground "orange"))
"Face for signatures that have expired."
:group 'magit-faces)
(defface magit-signature-expired-key
'((t :inherit magit-signature-expired))
"Face for signatures made by an expired key."
:group 'magit-faces)
(defface magit-signature-revoked
'((t :foreground "violet red"))
"Face for signatures made by a revoked key."
:group 'magit-faces)
(defface magit-signature-error
'((t :foreground "light blue"))
"Face for signatures that cannot be checked (e.g. missing key)."
:group 'magit-faces)
(defface magit-cherry-unmatched
'((t :foreground "cyan"))
"Face for unmatched cherry commits."
:group 'magit-faces)
(defface magit-cherry-equivalent
'((t :foreground "magenta"))
"Face for equivalent cherry commits."
:group 'magit-faces)
(defface magit-filename
'((t :weight normal))
"Face for filenames."
:group 'magit-faces)
;;; Global Bindings
;;;###autoload
(define-obsolete-variable-alias 'global-magit-file-mode
'magit-define-global-key-bindings "Magit 3.0.0")
;;;###autoload
(defcustom magit-define-global-key-bindings t
"Whether to bind some Magit commands in the global keymap.
If this variable is non-nil, then the following bindings may
be added to the global keymap. The default is t.
key binding
--- -------
C-x g magit-status
C-x M-g magit-dispatch
C-c M-g magit-file-dispatch
These bindings may be added when `after-init-hook' is run.
Each binding is added if and only if at that time no other key
is bound to the same command and no other command is bound to
the same key. In other words we try to avoid adding bindings
that are unnecessary, as well as bindings that conflict with
other bindings.
Adding the above bindings is delayed until `after-init-hook'
is called to allow users to set the variable anywhere in their
init file (without having to make sure to do so before `magit'
is loaded or autoloaded) and to increase the likelihood that
all the potentially conflicting user bindings have already
been added.
To set this variable use either `setq' or the Custom interface.
Do not use the function `customize-set-variable' because doing
that would cause Magit to be loaded immediately when that form
is evaluated (this differs from `custom-set-variables', which
doesn't load the libraries that define the customized variables).
Setting this variable to nil has no effect if that is done after
the key bindings have already been added.
We recommend that you bind \"C-c g\" instead of \"C-c M-g\" to
`magit-file-dispatch'. The former is a much better binding
but the \"C-c <letter>\" namespace is strictly reserved for
users; preventing Magit from using it by default.
Also see info node `(magit)Commands for Buffers Visiting Files'."
:package-version '(magit . "3.0.0")
:group 'magit-essentials
:type 'boolean)
;;;###autoload
(progn
(defun magit-maybe-define-global-key-bindings (&optional force)
(when magit-define-global-key-bindings
(let ((map (current-global-map)))
(dolist (elt '(("C-x g" . magit-status)
("C-x M-g" . magit-dispatch)
("C-c M-g" . magit-file-dispatch)))
(let ((key (kbd (car elt)))
(def (cdr elt)))
(when (or force
(not (or (lookup-key map key)
(where-is-internal def (make-sparse-keymap) t))))
(define-key map key def)))))))
(if after-init-time
(magit-maybe-define-global-key-bindings)
(add-hook 'after-init-hook #'magit-maybe-define-global-key-bindings t)))
;;; Dispatch Popup
;;;###autoload (autoload 'magit-dispatch "magit" nil t)
(transient-define-prefix magit-dispatch ()
"Invoke a Magit command from a list of available commands."
:info-manual "(magit)Top"
["Transient and dwim commands"
;; → bound in magit-mode-map or magit-section-mode-map
;; ↓ bound below
[("A" "Apply" magit-cherry-pick)
;; a ↓
("b" "Branch" magit-branch)
("B" "Bisect" magit-bisect)
("c" "Commit" magit-commit)
("C" "Clone" magit-clone)
("d" "Diff" magit-diff)
("D" "Diff (change)" magit-diff-refresh)
("e" "Ediff (dwim)" magit-ediff-dwim)
("E" "Ediff" magit-ediff)
("f" "Fetch" magit-fetch)
("F" "Pull" magit-pull)
;; g ↓
;; G → magit-refresh-all
("h" "Help" magit-info)
("H" "Section info" magit-describe-section :if-derived magit-mode)]
[("i" "Ignore" magit-gitignore)
("I" "Init" magit-init)
("j" "Jump to section"magit-status-jump :if-mode magit-status-mode)
("j" "Display status" magit-status-quick :if-not-mode magit-status-mode)
("J" "Display buffer" magit-display-repository-buffer)
;; k ↓
;; K → magit-file-untrack
("l" "Log" magit-log)
("L" "Log (change)" magit-log-refresh)
("m" "Merge" magit-merge)
("M" "Remote" magit-remote)
;; n → magit-section-forward
;; N reserved → forge-dispatch
("o" "Submodule" magit-submodule)
("O" "Subtree" magit-subtree)
;; p → magit-section-backward
("P" "Push" magit-push)
;; q → magit-mode-bury-buffer
("Q" "Command" magit-git-command)]
[("r" "Rebase" magit-rebase)
;; R → magit-file-rename
;; s ↓
;; S ↓
("t" "Tag" magit-tag)
("T" "Note" magit-notes)
;; u ↓
;; U ↓
;; v ↓
("V" "Revert" magit-revert)
("w" "Apply patches" magit-am)
("W" "Format patches" magit-patch)
;; x → magit-reset-quickly
("X" "Reset" magit-reset)
("y" "Show Refs" magit-show-refs)
("Y" "Cherries" magit-cherry)
("z" "Stash" magit-stash)
("Z" "Worktree" magit-worktree)
("!" "Run" magit-run)]]
["Applying changes"
:if-derived magit-mode
[("a" "Apply" magit-apply)
("v" "Reverse" magit-reverse)
("k" "Discard" magit-discard)]
[("s" "Stage" magit-stage)
("u" "Unstage" magit-unstage)]
[("S" "Stage all" magit-stage-modified)
("U" "Unstage all" magit-unstage-all)]]
["Essential commands"
:if-derived magit-mode
[("g" " refresh current buffer" magit-refresh)
("q" " bury current buffer" magit-mode-bury-buffer)
("<tab>" " toggle section at point" magit-section-toggle)
("<return>" "visit thing at point" magit-visit-thing)]
[("C-x m" "show all key bindings" describe-mode)
("C-x i" "show Info manual" magit-info)]])
;;; Git Popup
(defcustom magit-shell-command-verbose-prompt t
"Whether to show the working directory when reading a command.
This affects `magit-git-command', `magit-git-command-topdir',
`magit-shell-command', and `magit-shell-command-topdir'."
:package-version '(magit . "2.11.0")
:group 'magit-commands
:type 'boolean)
(defvar magit-git-command-history nil)
;;;###autoload (autoload 'magit-run "magit" nil t)
(transient-define-prefix magit-run ()
"Run git or another command, or launch a graphical utility."
[["Run git subcommand"
("!" "in repository root" magit-git-command-topdir)
("p" "in working directory" magit-git-command)]
["Run shell command"
("s" "in repository root" magit-shell-command-topdir)
("S" "in working directory" magit-shell-command)]
["Launch"
("k" "gitk" magit-run-gitk)
("a" "gitk --all" magit-run-gitk-all)
("b" "gitk --branches" magit-run-gitk-branches)
("g" "git gui" magit-run-git-gui)
("m" "git mergetool --gui" magit-git-mergetool)]])
;;;###autoload
(defun magit-git-command (command)
"Execute COMMAND asynchronously; display output.
Interactively, prompt for COMMAND in the minibuffer. \"git \" is
used as initial input, but can be deleted to run another command.
With a prefix argument COMMAND is run in the top-level directory
of the current working tree, otherwise in `default-directory'."
(interactive (list (magit-read-shell-command nil "git ")))
(magit--shell-command command))
;;;###autoload
(defun magit-git-command-topdir (command)
"Execute COMMAND asynchronously; display output.
Interactively, prompt for COMMAND in the minibuffer. \"git \" is
used as initial input, but can be deleted to run another command.
COMMAND is run in the top-level directory of the current
working tree."
(interactive (list (magit-read-shell-command t "git ")))
(magit--shell-command command (magit-toplevel)))
;;;###autoload
(defun magit-shell-command (command)
"Execute COMMAND asynchronously; display output.
Interactively, prompt for COMMAND in the minibuffer. With a
prefix argument COMMAND is run in the top-level directory of
the current working tree, otherwise in `default-directory'."
(interactive (list (magit-read-shell-command)))
(magit--shell-command command))
;;;###autoload
(defun magit-shell-command-topdir (command)
"Execute COMMAND asynchronously; display output.
Interactively, prompt for COMMAND in the minibuffer. COMMAND
is run in the top-level directory of the current working tree."
(interactive (list (magit-read-shell-command t)))
(magit--shell-command command (magit-toplevel)))
(defun magit--shell-command (command &optional directory)
(let ((default-directory (or directory default-directory)))
(with-environment-variables (("GIT_PAGER" "cat"))
(magit--with-connection-local-variables
(magit-start-process shell-file-name nil
shell-command-switch command))))
(magit-process-buffer))
(defun magit-read-shell-command (&optional toplevel initial-input)
(let ((default-directory
(if (or toplevel current-prefix-arg)
(or (magit-toplevel)
(magit--not-inside-repository-error))
default-directory)))
(read-shell-command (if magit-shell-command-verbose-prompt
(format "Async shell command in %s: "
(abbreviate-file-name default-directory))
"Async shell command: ")
initial-input 'magit-git-command-history)))
;;; Font-Lock Keywords
(defconst magit-font-lock-keywords
(eval-when-compile
`((,(concat "(\\(magit-define-section-jumper\\)\\_>"
"[ \t'\(]*"
"\\(\\(?:\\sw\\|\\s_\\)+\\)?")
(1 'font-lock-keyword-face)
(2 'font-lock-function-name-face nil t))
(,(concat "(" (regexp-opt '("magit-insert-section"
"magit-section-case"
"magit-bind-match-strings"
"magit-with-temp-index"
"magit-with-blob"
"magit-with-toplevel") t)
"\\_>")
. 1))))
(font-lock-add-keywords 'emacs-lisp-mode magit-font-lock-keywords)
;;; Version
(defvar magit-version #'undefined
"The version of Magit that you're using.
Use the function by the same name instead of this variable.")
;;;###autoload
(defun magit-version (&optional print-dest)
"Return the version of Magit currently in use.
If optional argument PRINT-DEST is non-nil, output
stream (interactively, the echo area, or the current buffer with
a prefix argument), also print the used versions of Magit, Git,
and Emacs to it."
(interactive (list (if current-prefix-arg (current-buffer) t)))
(let ((magit-git-global-arguments nil)
(toplib (or load-file-name buffer-file-name))
debug)
(unless (and toplib
(member (file-name-nondirectory toplib)
'("magit.el" "magit.el.gz")))
(let ((load-suffixes (reverse load-suffixes))) ; prefer .el than .elc
(setq toplib (locate-library "magit"))))
(setq toplib (and toplib (magit--straight-chase-links toplib)))
(push toplib debug)
(when toplib
(let* ((topdir (file-name-directory toplib))
(gitdir (expand-file-name
".git" (file-name-directory
(directory-file-name topdir))))
(static (locate-library "magit-version.el" nil (list topdir)))
(static (and static (magit--straight-chase-links static))))
(or (progn
(push 'repo debug)
(when (and (file-exists-p gitdir)
;; It is a repo, but is it the Magit repo?
(file-exists-p
(expand-file-name "../lisp/magit.el" gitdir)))
(push t debug)
;; Inside the repo the version file should only exist
;; while running make.
(when (and static (not noninteractive))
(ignore-errors (delete-file static)))
(setq magit-version
(let ((default-directory topdir))
(magit-git-string "describe"
"--tags" "--dirty" "--always")))))
(progn
(push 'static debug)
(when (and static (file-exists-p static))
(push t debug)
(load-file static)
magit-version))
(when (featurep 'package)
(push 'elpa debug)
(ignore-errors
(--when-let (assq 'magit package-alist)
(push t debug)
(setq magit-version
(and (fboundp 'package-desc-version)
(package-version-join
(package-desc-version (cadr it))))))))
(progn
(push 'dirname debug)
(let ((dirname (file-name-nondirectory
(directory-file-name topdir))))
(when (string-match "\\`magit-\\([0-9].*\\)" dirname)
(setq magit-version (match-string 1 dirname)))))
;; If all else fails, just report the commit hash. It's
;; better than nothing and we cannot do better in the case
;; of e.g. a shallow clone.
(progn
(push 'hash debug)
;; Same check as above to see if it's really the Magit repo.
(when (and (file-exists-p gitdir)
(file-exists-p
(expand-file-name "../lisp/magit.el" gitdir)))
(setq magit-version
(let ((default-directory topdir))
(magit-git-string "rev-parse" "HEAD"))))))))
(if (stringp magit-version)
(when print-dest
(princ (format "Magit %s%s, Git %s, Emacs %s, %s"
(or magit-version "(unknown)")
(or (and (ignore-errors
(magit--version>= magit-version "2008"))
(ignore-errors
(require 'lisp-mnt)
(and (fboundp 'lm-header)
(format
" [>= %s]"
(with-temp-buffer
(insert-file-contents
(locate-library "magit.el" t))
(lm-header "Package-Version"))))))
"")
(magit--safe-git-version)
emacs-version
system-type)
print-dest))
(setq debug (reverse debug))
(setq magit-version 'error)
(when magit-version
(push magit-version debug))
(unless (equal (getenv "CI") "true")
;; The repository is a sparse clone.
(message "Cannot determine Magit's version %S" debug)))
magit-version))
;;; Startup Asserts
(defun magit-startup-asserts ()
(when-let ((val (getenv "GIT_DIR")))
(setenv "GIT_DIR")
(message
"Magit unset $GIT_DIR (was %S). See %s" val
;; Note: Pass URL as argument rather than embedding in the format
;; string to prevent the single quote from being rendered
;; according to `text-quoting-style'.
"https://github.com/magit/magit/wiki/Don't-set-$GIT_DIR-and-alike"))
(when-let ((val (getenv "GIT_WORK_TREE")))
(setenv "GIT_WORK_TREE")
(message
"Magit unset $GIT_WORK_TREE (was %S). See %s" val
;; See comment above.
"https://github.com/magit/magit/wiki/Don't-set-$GIT_DIR-and-alike"))
;; Git isn't required while building Magit.
(unless byte-compile-current-file
(magit-git-version-assert))
(when (version< emacs-version magit--minimal-emacs)
(display-warning 'magit (format "\
Magit requires Emacs >= %s, you are using %s.
If this comes as a surprise to you, because you do actually have
a newer version installed, then that probably means that the
older version happens to appear earlier on the `$PATH'. If you
always start Emacs from a shell, then that can be fixed in the
shell's init file. If you start Emacs by clicking on an icon,
or using some sort of application launcher, then you probably
have to adjust the environment as seen by graphical interface.
For X11 something like ~/.xinitrc should work.\n"
magit--minimal-emacs emacs-version)
:error)))
;;; Loading Libraries
(provide 'magit)
(cl-eval-when (load eval)
(require 'magit-status)
(require 'magit-refs)
(require 'magit-files)
(require 'magit-reset)
(require 'magit-branch)
(require 'magit-merge)
(require 'magit-tag)
(require 'magit-worktree)
(require 'magit-notes)
(require 'magit-sequence)
(require 'magit-commit)
(require 'magit-remote)
(require 'magit-clone)
(require 'magit-fetch)
(require 'magit-pull)
(require 'magit-push)
(require 'magit-bisect)
(require 'magit-stash)
(require 'magit-blame)
(require 'magit-obsolete)
(require 'magit-submodule)
(unless (load "magit-autoloads" t t)
(require 'magit-patch)
(require 'magit-subtree)
(require 'magit-ediff)
(require 'magit-gitignore)
(require 'magit-sparse-checkout)
(require 'magit-extras)
(require 'git-rebase)
(require 'magit-bookmark)))
(with-eval-after-load 'bookmark
(require 'magit-bookmark))
(unless byte-compile-current-file
(if after-init-time
(progn (magit-startup-asserts)
(magit-version))
(add-hook 'after-init-hook #'magit-startup-asserts t)
(add-hook 'after-init-hook #'magit-version t)))
;;; magit.el ends here

11184
code/elpa/magit-20220425.1153/magit.info Normal file
View file

File diff suppressed because it is too large Load diff

19
code/elpa/magit-section-20220425.1002/dir Normal file
View file

@ -0,0 +1,19 @@
This is the file .../info/dir, which contains the
topmost node of the Info hierarchy, called (dir)Top.
The first time you invoke Info you start off looking at this node.

File: dir, Node: Top This is the top of the INFO tree
This (the Directory node) gives a menu of major topics.
Typing "q" exits, "H" lists all Info commands, "d" returns here,
"h" gives a primer for first-timers,
"mEmacs<Return>" visits the Emacs manual, etc.
In Emacs, you can click mouse button 2 on a menu item or cross reference
to select it.
* Menu:
Emacs
* Magit-Section: (magit-section).
Use Magit sections in your own packages.

26
code/elpa/magit-section-20220425.1002/magit-section-autoloads.el Normal file
View file

@ -0,0 +1,26 @@
;;; magit-section-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*-
;;
;;; Code:
(add-to-list 'load-path (directory-file-name
(or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil "magit-section" "magit-section.el" (0 0 0 0))
;;; Generated autoloads from magit-section.el
(register-definition-prefixes "magit-section" '("isearch-clean-overlays@magit-mode" "magit-"))
;;;***
;;;### (autoloads nil nil ("magit-section-pkg.el") (0 0 0 0))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; magit-section-autoloads.el ends here

14
code/elpa/magit-section-20220425.1002/magit-section-pkg.el Normal file
View file

@ -0,0 +1,14 @@
(define-package "magit-section" "20220425.1002" "Sections for read-only buffers"
'((emacs "25.1")
(compat "28.1.0.4")
(dash "20210826"))
:commit "3cb7f5ba430906bded9e5d9951f5260ab25644d0" :authors
'(("Jonas Bernoulli" . "jonas@bernoul.li"))
:maintainer
'("Jonas Bernoulli" . "jonas@bernoul.li")
:keywords
'("tools")
:url "https://github.com/magit/magit")
;; Local Variables:
;; no-byte-compile: t
;; End:

2202
code/elpa/magit-section-20220425.1002/magit-section.el Normal file
View file

File diff suppressed because it is too large Load diff

307
code/elpa/magit-section-20220425.1002/magit-section.info Normal file
View file

@ -0,0 +1,307 @@
This is magit-section.info, produced by makeinfo version 6.7 from
magit-section.texi.
Copyright (C) 2015-2022 Jonas Bernoulli <jonas@bernoul.li>
You can redistribute this document and/or modify it under the terms
of the GNU General Public License as published by the Free Software
Foundation, either version 3 of the License, or (at your option)
any later version.
This document 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.
INFO-DIR-SECTION Emacs
START-INFO-DIR-ENTRY
* Magit-Section: (magit-section). Use Magit sections in your own packages.
END-INFO-DIR-ENTRY

File: magit-section.info, Node: Top, Next: Introduction, Up: (dir)
Magit-Section Developer Manual
******************************
This package implements the main user interface of Magit — the
collapsible sections that make up its buffers. This package used to be
distributed as part of Magit but how it can also be used by other
packages that have nothing to do with Magit or Git.
To learn more about the section abstraction and available commands
and user options see *note (magit)Sections::. This manual documents how
you can use sections in your own packages.
This manual is for Magit-Section version 3.3.0-git.
Copyright (C) 2015-2022 Jonas Bernoulli <jonas@bernoul.li>
You can redistribute this document and/or modify it under the terms
of the GNU General Public License as published by the Free Software
Foundation, either version 3 of the License, or (at your option)
any later version.
This document 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.
* Menu:
* Introduction::
* Creating Sections::
* Core Functions::
* Matching Functions::

File: magit-section.info, Node: Introduction, Next: Creating Sections, Prev: Top, Up: Top
1 Introduction
**************
This package implements the main user interface of Magit — the
collapsible sections that make up its buffers. This package used to be
distributed as part of Magit but how it can also be used by other
packages that have nothing to do with Magit or Git.
To learn more about the section abstraction and available commands
and user options see *note (magit)Sections::. This manual documents how
you can use sections in your own packages.
When the documentation leaves something unaddressed, then please
consider that Magit uses this library extensively and search its source
for suitable examples before asking me for help. Thanks!

File: magit-section.info, Node: Creating Sections, Next: Core Functions, Prev: Introduction, Up: Top
2 Creating Sections
*******************
-- Macro: magit-insert-section [name] (type &optional value hide) &rest
body
Create a section object of type CLASS, storing VALUE in its ‘value’
slot, and insert the section at point. CLASS is a subclass of
‘magit-section’ or has the form ‘(eval FORM)’, in which case FORM
is evaluated at runtime and should return a subclass. In other
places a sections class is oftern referred to as its "type".
Many commands behave differently depending on the class of the
current section and sections of a certain class can have their own
keymap, which is specified using the ‘keymap’ class slot. The
value of that slot should be a variable whose value is a keymap.
For historic reasons Magit and Forge in most cases use symbols as
CLASS that don’t actually identify a class and that lack the
appropriate package prefix. This works due to some undocumented
kludges, which are not available to other packages.
When optional HIDE is non-nil collapse the section body by default,
i.e. when first creating the section, but not when refreshing the
buffer. Else expand it by default. This can be overwritten using
‘magit-section-set-visibility-hook’. When a section is recreated
during a refresh, then the visibility of predecessor is inherited
and HIDE is ignored (but the hook is still honored).
BODY is any number of forms that actually insert the section’s
heading and body. Optional NAME, if specified, has to be a symbol,
which is then bound to the object of the section being inserted.
Before BODY is evaluated the ‘start’ of the section object is set
to the value of ‘point’ and after BODY was evaluated its ‘end’ is
set to the new value of ‘point’; BODY is responsible for moving
‘point’ forward.
If it turns out inside BODY that the section is empty, then
‘magit-cancel-section’ can be used to abort and remove all traces
of the partially inserted section. This can happen when creating a
section by washing Git’s output and Git didn’t actually output
anything this time around.
-- Function: magit-insert-heading &rest args
Insert the heading for the section currently being inserted.
This function should only be used inside ‘magit-insert-section’.
When called without any arguments, then just set the ‘content’ slot
of the object representing the section being inserted to a marker
at ‘point’. The section should only contain a single line when
this function is used like this.
When called with arguments ARGS, which have to be strings, or nil,
then insert those strings at point. The section should not contain
any text before this happens and afterwards it should again only
contain a single line. If the ‘face’ property is set anywhere
inside any of these strings, then insert all of them unchanged.
Otherwise use the ‘magit-section-heading’ face for all inserted
text.
The ‘content’ property of the section object is the end of the
heading (which lasts from ‘start’ to ‘content’) and the beginning
of the the body (which lasts from ‘content’ to ‘end’). If the
value of ‘content’ is nil, then the section has no heading and its
body cannot be collapsed. If a section does have a heading, then
its height must be exactly one line, including a trailing newline
character. This isn’t enforced, you are responsible for getting it
right. The only exception is that this function does insert a
newline character if necessary.
-- Macro: magit-insert-section-body &rest body
Use BODY to insert the section body, once the section is expanded.
If the section is expanded when it is created, then this is like
‘progn’. Otherwise BODY isn’t evaluated until the section is
explicitly expanded.
-- Function: magit-cancel-section
Cancel inserting the section that is currently being inserted.
Remove all traces of that section.
-- Function: magit-wash-sequence function
Repeatedly call FUNCTION until it returns ‘nil’ or the end of the
buffer is reached. FUNCTION has to move point forward or return
‘nil’.

File: magit-section.info, Node: Core Functions, Next: Matching Functions, Prev: Creating Sections, Up: Top
3 Core Functions
****************
-- Function: magit-current-section
Return the section at point or where the context menu was invoked.
When using the context menu, return the section that the user
clicked on, provided the current buffer is the buffer in which the
click occured. Otherwise return the section at point.
Function magit-section-at &optional position
Return the section at POSITION, defaulting to point. Default to
point even when the context menu is used.
-- Function: magit-section-ident section
Return an unique identifier for SECTION. The return value has the
form ‘((TYPE . VALUE)...)’.
-- Function: magit-section-ident-value value
Return a constant representation of VALUE.
VALUE is the value of a ‘magit-section’ object. If that is an
object itself, then that is not suitable to be used to identify the
section because two objects may represent the same thing but not be
equal. If possible a method should be added for such objects,
which returns a value that is equal. Otherwise the catch-all
method is used, which just returns the argument itself.
-- Function: magit-get-section ident &optional root
Return the section identified by IDENT. IDENT has to be a list as
returned by ‘magit-section-ident’. If optional ROOT is non-nil,
then search in that section tree instead of in the one whose root
‘magit-root-section’ is.
-- Function: magit-section-lineage section
Return the lineage of SECTION. The return value has the form
‘(TYPE...)’.
-- Function: magit-section-content-p section
Return non-nil if SECTION has content or an unused washer function.
The next two functions are replacements for the Emacs functions that
have the same name except for the ‘magit-’ prefix. Like
‘magit-current-section’ they do not act on point, the cursors position,
but on the position where the user clicked to invoke the context menu.
If your package provides a context menu and some of its commands act
on the "thing at point", even if just as a default, then use the
prefixed functions to teach them to instead use the click location when
appropriate.
Function magit-point
Return point or the position where the context menu was invoked.
When using the context menu, return the position the user clicked
on, provided the current buffer is the buffer in which the click
occured. Otherwise return the same value as ‘point’.
Function magit-thing-at-point thing &optional no-properties
Return the THING at point or where the context menu was invoked.
When using the context menu, return the thing the user clicked on,
provided the current buffer is the buffer in which the click
occured. Otherwise return the same value as ‘thing-at-point’. For
the meaning of THING and NO-PROPERTIES see that function.

File: magit-section.info, Node: Matching Functions, Prev: Core Functions, Up: Top
4 Matching Functions
********************
-- Function: magit-section-match condition &optional (section
(magit-current-section))
Return t if SECTION matches CONDITION.
SECTION defaults to the section at point. If SECTION is not
specified and there also is no section at point, then return nil.
CONDITION can take the following forms:
• ‘(CONDITION...)’ matches if any of the CONDITIONs matches.
• ‘[CLASS...]’ matches if the section’s class is the same as the
first CLASS or a subclass of that; the section’s parent class
matches the second CLASS; and so on.
• ‘[* CLASS...]’ matches sections that match [CLASS...] and also
recursively all their child sections.
• ‘CLASS’ matches if the section’s class is the same as CLASS or
a subclass of that; regardless of the classes of the parent
sections.
Each CLASS should be a class symbol, identifying a class that
derives from ‘magit-section’. For backward compatibility CLASS can
also be a "type symbol". A section matches such a symbol if the
value of its ‘type’ slot is ‘eq’. If a type symbol has an entry in
‘magit--section-type-alist’, then a section also matches that type
if its class is a subclass of the class that corresponds to the
type as per that alist.
Note that it is not necessary to specify the complete section
lineage as printed by ‘magit-describe-section-briefly’, unless of
course you want to be that precise.
-- Function: magit-section-value-if condition &optional section
If the section at point matches CONDITION, then return its value.
If optional SECTION is non-nil then test whether that matches
instead. If there is no section at point and SECTION is nil, then
return nil. If the section does not match, then return nil.
See ‘magit-section-match’ for the forms CONDITION can take.
-- Macro: magit-section-case &rest clauses
Choose among clauses on the type of the section at point.
Each clause looks like ‘(CONDITION BODY...)’. The type of the
section is compared against each CONDITION; the BODY forms of the
first match are evaluated sequentially and the value of the last
form is returned. Inside BODY the symbol ‘it’ is bound to the
section at point. If no clause succeeds or if there is no section
at point, return nil.
See ‘magit-section-match’ for the forms CONDITION can take.
Additionally a CONDITION of t is allowed in the final clause, and
matches if no other CONDITION match, even if there is no section at
point.

Tag Table:
Node: Top788
Node: Introduction2073
Node: Creating Sections2843
Node: Core Functions7352
Node: Matching Functions10402

End Tag Table

Local Variables:
coding: utf-8
End:

18
code/elpa/transient-20220425.1314/dir Normal file
View file

@ -0,0 +1,18 @@
This is the file .../info/dir, which contains the
topmost node of the Info hierarchy, called (dir)Top.
The first time you invoke Info you start off looking at this node.

File: dir, Node: Top This is the top of the INFO tree
This (the Directory node) gives a menu of major topics.
Typing "q" exits, "H" lists all Info commands, "d" returns here,
"h" gives a primer for first-timers,
"mEmacs<Return>" visits the Emacs manual, etc.
In Emacs, you can click mouse button 2 on a menu item or cross reference
to select it.
* Menu:
Emacs
* Transient: (transient). Transient Commands.

80
code/elpa/transient-20220425.1314/transient-autoloads.el Normal file
View file

@ -0,0 +1,80 @@
;;; transient-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*-
;;
;;; Code:
(add-to-list 'load-path (directory-file-name
(or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil "transient" "transient.el" (0 0 0 0))
;;; Generated autoloads from transient.el
(autoload 'transient-insert-suffix "transient" "\
Insert a SUFFIX into PREFIX before LOC.
PREFIX is a prefix command, a symbol.
SUFFIX is a suffix command or a group specification (of
the same forms as expected by `transient-define-prefix').
LOC is a command, a key vector, a key description (a string
as returned by `key-description'), or a coordination list
(whose last element may also be a command or key).
See info node `(transient)Modifying Existing Transients'.
\(fn PREFIX LOC SUFFIX)" nil nil)
(function-put 'transient-insert-suffix 'lisp-indent-function 'defun)
(autoload 'transient-append-suffix "transient" "\
Insert a SUFFIX into PREFIX after LOC.
PREFIX is a prefix command, a symbol.
SUFFIX is a suffix command or a group specification (of
the same forms as expected by `transient-define-prefix').
LOC is a command, a key vector, a key description (a string
as returned by `key-description'), or a coordination list
(whose last element may also be a command or key).
See info node `(transient)Modifying Existing Transients'.
\(fn PREFIX LOC SUFFIX)" nil nil)
(function-put 'transient-append-suffix 'lisp-indent-function 'defun)
(autoload 'transient-replace-suffix "transient" "\
Replace the suffix at LOC in PREFIX with SUFFIX.
PREFIX is a prefix command, a symbol.
SUFFIX is a suffix command or a group specification (of
the same forms as expected by `transient-define-prefix').
LOC is a command, a key vector, a key description (a string
as returned by `key-description'), or a coordination list
(whose last element may also be a command or key).
See info node `(transient)Modifying Existing Transients'.
\(fn PREFIX LOC SUFFIX)" nil nil)
(function-put 'transient-replace-suffix 'lisp-indent-function 'defun)
(autoload 'transient-remove-suffix "transient" "\
Remove the suffix or group at LOC in PREFIX.
PREFIX is a prefix command, a symbol.
LOC is a command, a key vector, a key description (a string
as returned by `key-description'), or a coordination list
(whose last element may also be a command or key).
See info node `(transient)Modifying Existing Transients'.
\(fn PREFIX LOC)" nil nil)
(function-put 'transient-remove-suffix 'lisp-indent-function 'defun)
(register-definition-prefixes "transient" '("magit--fit-window-to-buffer" "transient-"))
;;;***
;;;### (autoloads nil nil ("transient-pkg.el") (0 0 0 0))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; transient-autoloads.el ends here

13
code/elpa/transient-20220425.1314/transient-pkg.el Normal file
View file

@ -0,0 +1,13 @@
(define-package "transient" "20220425.1314" "Transient commands"
'((emacs "25.1")
(compat "28.1.1.0"))
:commit "84f2d12ef31ec74c85e616283926780532fed13f" :authors
'(("Jonas Bernoulli" . "jonas@bernoul.li"))
:maintainer
'("Jonas Bernoulli" . "jonas@bernoul.li")
:keywords
'("extensions")
:url "https://github.com/magit/transient")
;; Local Variables:
;; no-byte-compile: t
;; End:

4073
code/elpa/transient-20220425.1314/transient.el Normal file
View file

File diff suppressed because it is too large Load diff

2648
code/elpa/transient-20220425.1314/transient.info Normal file
View file

File diff suppressed because it is too large Load diff

18
code/elpa/with-editor-20220422.1628/dir Normal file
View file

@ -0,0 +1,18 @@
This is the file .../info/dir, which contains the
topmost node of the Info hierarchy, called (dir)Top.
The first time you invoke Info you start off looking at this node.

File: dir, Node: Top This is the top of the INFO tree
This (the Directory node) gives a menu of major topics.
Typing "q" exits, "H" lists all Info commands, "d" returns here,
"h" gives a primer for first-timers,
"mEmacs<Return>" visits the Emacs manual, etc.
In Emacs, you can click mouse button 2 on a menu item or cross reference
to select it.
* Menu:
Emacs
* With-Editor: (with-editor). Using the Emacsclient as $EDITOR.

111
code/elpa/with-editor-20220422.1628/with-editor-autoloads.el Normal file
View file

@ -0,0 +1,111 @@
;;; with-editor-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*-
;;
;;; Code:
(add-to-list 'load-path (directory-file-name
(or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil "with-editor" "with-editor.el" (0 0 0 0))
;;; Generated autoloads from with-editor.el
(autoload 'with-editor-export-editor "with-editor" "\
Teach subsequent commands to use current Emacs instance as editor.
Set and export the environment variable ENVVAR, by default
\"EDITOR\". The value is automatically generated to teach
commands to use the current Emacs instance as \"the editor\".
This works in `shell-mode', `term-mode', `eshell-mode' and
`vterm'.
\(fn &optional (ENVVAR \"EDITOR\"))" t nil)
(autoload 'with-editor-export-git-editor "with-editor" "\
Like `with-editor-export-editor' but always set `$GIT_EDITOR'." t nil)
(autoload 'with-editor-export-hg-editor "with-editor" "\
Like `with-editor-export-editor' but always set `$HG_EDITOR'." t nil)
(defvar shell-command-with-editor-mode nil "\
Non-nil if Shell-Command-With-Editor mode is enabled.
See the `shell-command-with-editor-mode' command
for a description of this minor mode.")
(custom-autoload 'shell-command-with-editor-mode "with-editor" nil)
(autoload 'shell-command-with-editor-mode "with-editor" "\
Teach `shell-command' to use current Emacs instance as editor.
This is a minor mode. If called interactively, toggle the
`Shell-Command-With-Editor mode' mode. If the prefix argument is
positive, enable the mode, and if it is zero or negative, disable
the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable
the mode if ARG is nil, omitted, or is a positive number.
Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='shell-command-with-editor-mode)'.
The mode's hook is called both when the mode is enabled and when
it is disabled.
Teach `shell-command', and all commands that ultimately call that
command, to use the current Emacs instance as editor by executing
\"EDITOR=CLIENT COMMAND&\" instead of just \"COMMAND&\".
CLIENT is automatically generated; EDITOR=CLIENT instructs
COMMAND to use to the current Emacs instance as \"the editor\",
assuming no other variable overrides the effect of \"$EDITOR\".
CLIENT may be the path to an appropriate emacsclient executable
with arguments, or a script which also works over Tramp.
Alternatively you can use the `with-editor-async-shell-command',
which also allows the use of another variable instead of
\"EDITOR\".
\(fn &optional ARG)" t nil)
(autoload 'with-editor-async-shell-command "with-editor" "\
Like `async-shell-command' but with `$EDITOR' set.
Execute string \"ENVVAR=CLIENT COMMAND\" in an inferior shell;
display output, if any. With a prefix argument prompt for an
environment variable, otherwise the default \"EDITOR\" variable
is used. With a negative prefix argument additionally insert
the COMMAND's output at point.
CLIENT is automatically generated; ENVVAR=CLIENT instructs
COMMAND to use to the current Emacs instance as \"the editor\",
assuming it respects ENVVAR as an \"EDITOR\"-like variable.
CLIENT may be the path to an appropriate emacsclient executable
with arguments, or a script which also works over Tramp.
Also see `async-shell-command' and `shell-command'.
\(fn COMMAND &optional OUTPUT-BUFFER ERROR-BUFFER ENVVAR)" t nil)
(autoload 'with-editor-shell-command "with-editor" "\
Like `shell-command' or `with-editor-async-shell-command'.
If COMMAND ends with \"&\" behave like the latter,
else like the former.
\(fn COMMAND &optional OUTPUT-BUFFER ERROR-BUFFER ENVVAR)" t nil)
(register-definition-prefixes "with-editor" '("server-" "shell-command--shell-command-with-editor-mode" "start-file-process--with-editor-process-filter" "with-editor"))
;;;***
;;;### (autoloads nil nil ("with-editor-pkg.el") (0 0 0 0))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; with-editor-autoloads.el ends here

13
code/elpa/with-editor-20220422.1628/with-editor-pkg.el Normal file
View file

@ -0,0 +1,13 @@
(define-package "with-editor" "20220422.1628" "Use the Emacsclient as $EDITOR"
'((emacs "25.1")
(compat "28.1.1.0"))
:commit "54d1e816ac0f3203f0065ea9e6a551b9d103dad4" :authors
'(("Jonas Bernoulli" . "jonas@bernoul.li"))
:maintainer
'("Jonas Bernoulli" . "jonas@bernoul.li")
:keywords
'("processes" "terminals")
:url "https://github.com/magit/with-editor")
;; Local Variables:
;; no-byte-compile: t
;; End:

949
code/elpa/with-editor-20220422.1628/with-editor.el Normal file
View file

@ -0,0 +1,949 @@
;;; with-editor.el --- Use the Emacsclient as $EDITOR -*- lexical-binding:t -*-
;; Copyright (C) 2014-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Homepage: https://github.com/magit/with-editor
;; Keywords: processes terminals
;; Package-Version: 3.2.0-git
;; Package-Requires: ((emacs "25.1") (compat "28.1.1.0"))
;; SPDX-License-Identifier: GPL-3.0-or-later
;; This file is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published
;; by the Free Software Foundation, either version 3 of the License,
;; or (at your option) any later version.
;;
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this file. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library makes it possible to reliably use the Emacsclient as
;; the `$EDITOR' of child processes. It makes sure that they know how
;; to call home. For remote processes a substitute is provided, which
;; communicates with Emacs on standard output/input instead of using a
;; socket as the Emacsclient does.
;; It provides the commands `with-editor-async-shell-command' and
;; `with-editor-shell-command', which are intended as replacements
;; for `async-shell-command' and `shell-command'. They automatically
;; export `$EDITOR' making sure the executed command uses the current
;; Emacs instance as "the editor". With a prefix argument these
;; commands prompt for an alternative environment variable such as
;; `$GIT_EDITOR'. To always use these variants add this to your init
;; file:
;;
;; (define-key (current-global-map)
;; [remap async-shell-command] #'with-editor-async-shell-command)
;; (define-key (current-global-map)
;; [remap shell-command] #'with-editor-shell-command)
;; Alternatively use the global `shell-command-with-editor-mode',
;; which always sets `$EDITOR' for all Emacs commands which ultimately
;; use `shell-command' to asynchronously run some shell command.
;; The command `with-editor-export-editor' exports `$EDITOR' or
;; another such environment variable in `shell-mode', `eshell-mode',
;; `term-mode' and `vterm-mode' buffers. Use this Emacs command
;; before executing a shell command which needs the editor set, or
;; always arrange for the current Emacs instance to be used as editor
;; by adding it to the appropriate mode hooks:
;;
;; (add-hook 'shell-mode-hook #'with-editor-export-editor)
;; (add-hook 'eshell-mode-hook #'with-editor-export-editor)
;; (add-hook 'term-exec-hook #'with-editor-export-editor)
;; (add-hook 'vterm-mode-hook #'with-editor-export-editor)
;; Some variants of this function exist, these two forms are
;; equivalent:
;;
;; (add-hook 'shell-mode-hook
;; (apply-partially #'with-editor-export-editor "GIT_EDITOR"))
;; (add-hook 'shell-mode-hook #'with-editor-export-git-editor)
;; This library can also be used by other packages which need to use
;; the current Emacs instance as editor. In fact this library was
;; written for Magit and its `git-commit-mode' and `git-rebase-mode'.
;; Consult `git-rebase.el' and the related code in `magit-sequence.el'
;; for a simple example.
;;; Code:
(require 'cl-lib)
(require 'compat)
(require 'server)
(require 'shell)
(eval-when-compile (require 'subr-x))
(eval-when-compile
(progn (require 'dired nil t)
(require 'eshell nil t)
(require 'term nil t)
(condition-case err
(require 'vterm nil t)
(error (message "Error(vterm): %S" err)))
(require 'warnings nil t)))
(declare-function dired-get-filename 'dired)
(declare-function term-emulate-terminal 'term)
(declare-function vterm-send-return 'vterm)
(declare-function vterm-send-string 'vterm)
(defvar eshell-preoutput-filter-functions)
(defvar git-commit-post-finish-hook)
(defvar vterm--process)
;;; Options
(defgroup with-editor nil
"Use the Emacsclient as $EDITOR."
:group 'external
:group 'server)
(defun with-editor-locate-emacsclient ()
"Search for a suitable Emacsclient executable."
(or (with-editor-locate-emacsclient-1
(with-editor-emacsclient-path)
(length (split-string emacs-version "\\.")))
(prog1 nil (display-warning 'with-editor "\
Cannot determine a suitable Emacsclient
Determining an Emacsclient executable suitable for the
current Emacs instance failed. For more information
please see https://github.com/magit/magit/wiki/Emacsclient."))))
(defun with-editor-locate-emacsclient-1 (path depth)
(let* ((version-lst (cl-subseq (split-string emacs-version "\\.") 0 depth))
(version-reg (concat "^" (mapconcat #'identity version-lst "\\."))))
(or (locate-file
(if (equal (downcase invocation-name) "remacs")
"remacsclient"
"emacsclient")
path
(cl-mapcan
(lambda (v) (cl-mapcar (lambda (e) (concat v e)) exec-suffixes))
(nconc (and (boundp 'debian-emacs-flavor)
(list (format ".%s" debian-emacs-flavor)))
(cl-mapcon (lambda (v)
(setq v (mapconcat #'identity (reverse v) "."))
(list v (concat "-" v) (concat ".emacs" v)))
(reverse version-lst))
(list "" "-snapshot" ".emacs-snapshot")))
(lambda (exec)
(ignore-errors
(string-match-p version-reg
(with-editor-emacsclient-version exec)))))
(and (> depth 1)
(with-editor-locate-emacsclient-1 path (1- depth))))))
(defun with-editor-emacsclient-version (exec)
(let ((default-directory (file-name-directory exec)))
(ignore-errors
(cadr (split-string (car (process-lines exec "--version")))))))
(defun with-editor-emacsclient-path ()
(let ((path exec-path))
(when invocation-directory
(push (directory-file-name invocation-directory) path)
(let* ((linkname (expand-file-name invocation-name invocation-directory))
(truename (file-chase-links linkname)))
(unless (equal truename linkname)
(push (directory-file-name (file-name-directory truename)) path)))
(when (eq system-type 'darwin)
(let ((dir (expand-file-name "bin" invocation-directory)))
(when (file-directory-p dir)
(push dir path)))
(when (string-search "Cellar" invocation-directory)
(let ((dir (expand-file-name "../../../bin" invocation-directory)))
(when (file-directory-p dir)
(push dir path))))))
(cl-remove-duplicates path :test #'equal)))
(defcustom with-editor-emacsclient-executable (with-editor-locate-emacsclient)
"The Emacsclient executable used by the `with-editor' macro."
:group 'with-editor
:type '(choice (string :tag "Executable")
(const :tag "Don't use Emacsclient" nil)))
(defcustom with-editor-sleeping-editor "\
sh -c '\
printf \"\\nWITH-EDITOR: $$ OPEN $0\\037 IN $(pwd)\\n\"; \
sleep 604800 & sleep=$!; \
trap \"kill $sleep; exit 0\" USR1; \
trap \"kill $sleep; exit 1\" USR2; \
wait $sleep'"
"The sleeping editor, used when the Emacsclient cannot be used.
This fallback is used for asynchronous processes started inside
the macro `with-editor', when the process runs on a remote machine
or for local processes when `with-editor-emacsclient-executable'
is nil (i.e. when no suitable Emacsclient was found, or the user
decided not to use it).
Where the latter uses a socket to communicate with Emacs' server,
this substitute prints edit requests to its standard output on
which a process filter listens for such requests. As such it is
not a complete substitute for a proper Emacsclient, it can only
be used as $EDITOR of child process of the current Emacs instance.
Some shells do not execute traps immediately when waiting for a
child process, but by default we do use such a blocking child
process.
If you use such a shell (e.g. `csh' on FreeBSD, but not Debian),
then you have to edit this option. You can either replace \"sh\"
with \"bash\" (and install that), or you can use the older, less
performant implementation:
\"sh -c '\\
echo -e \\\"\\nWITH-EDITOR: $$ OPEN $0 IN $(pwd)\\n\\\"; \\
trap \\\"exit 0\\\" USR1; \\
trap \\\"exit 1\" USR2; \\
while true; do sleep 1; done'\"
Note that the unit separator character () right after the file
name ($0) is required.
Also note that using this alternative implementation leads to a
delay of up to a second. The delay can be shortened by replacing
\"sleep 1\" with \"sleep 0.01\", or if your implementation does
not support floats, then by using \"nanosleep\" instead."
:package-version '(with-editor . "2.8.0")
:group 'with-editor
:type 'string)
(defcustom with-editor-finish-query-functions nil
"List of functions called to query before finishing session.
The buffer in question is current while the functions are called.
If any of them returns nil, then the session is not finished and
the buffer is not killed. The user should then fix the issue and
try again. The functions are called with one argument. If it is
non-nil then that indicates that the user used a prefix argument
to force finishing the session despite issues. Functions should
usually honor that and return non-nil."
:group 'with-editor
:type 'hook)
(put 'with-editor-finish-query-functions 'permanent-local t)
(defcustom with-editor-cancel-query-functions nil
"List of functions called to query before canceling session.
The buffer in question is current while the functions are called.
If any of them returns nil, then the session is not canceled and
the buffer is not killed. The user should then fix the issue and
try again. The functions are called with one argument. If it is
non-nil then that indicates that the user used a prefix argument
to force canceling the session despite issues. Functions should
usually honor that and return non-nil."
:group 'with-editor
:type 'hook)
(put 'with-editor-cancel-query-functions 'permanent-local t)
(defcustom with-editor-mode-lighter " WE"
"The mode-line lighter of the With-Editor mode."
:group 'with-editor
:type '(choice (const :tag "No lighter" "") string))
(defvar with-editor-server-window-alist nil
"Alist of filename patterns vs corresponding `server-window'.
Each element looks like (REGEXP . FUNCTION). Files matching
REGEXP are selected using FUNCTION instead of the default in
`server-window'.
Note that when a package adds an entry here then it probably
has a reason to disrespect `server-window' and it likely is
not a good idea to change such entries.")
(defvar with-editor-file-name-history-exclude nil
"List of regexps for filenames `server-visit' should not remember.
When a filename matches any of the regexps, then `server-visit'
does not add it to the variable `file-name-history', which is
used when reading a filename in the minibuffer.")
(defcustom with-editor-shell-command-use-emacsclient t
"Whether to use the emacsclient when running shell commands.
This affects `with-editor-shell-command-async' and, if the input
ends with \"&\" `with-editor-shell-command' .
If `shell-command-with-editor-mode' is enabled, then it also
affects `shell-command-async' and, if the input ends with \"&\"
`shell-command'.
This is a temporary kludge that lets you choose between two
possible defects, the ones described in the issues #23 and #40.
When t, then use the emacsclient. This has the disadvantage that
`with-editor-mode' won't be enabled because we don't know whether
this package was involved at all in the call to the emacsclient,
and when it is not, then we really should. The problem is that
the emacsclient doesn't pass a long any environment variables to
the server. This will hopefully be fixed in Emacs eventually.
When nil, then use the sleeping editor. Because in this case we
know that this package is involved, we can enable the mode. But
this makes it necessary that you invoke $EDITOR in shell scripts
like so:
eval \"$EDITOR\" file
And some tools that do not handle $EDITOR properly also break."
:package-version '(with-editor . "2.7.1")
:group 'with-editor
:type 'boolean)
;;; Mode Commands
(defvar with-editor-pre-finish-hook nil)
(defvar with-editor-pre-cancel-hook nil)
(defvar with-editor-post-finish-hook nil)
(defvar with-editor-post-finish-hook-1 nil)
(defvar with-editor-post-cancel-hook nil)
(defvar with-editor-post-cancel-hook-1 nil)
(defvar with-editor-cancel-alist nil)
(put 'with-editor-pre-finish-hook 'permanent-local t)
(put 'with-editor-pre-cancel-hook 'permanent-local t)
(put 'with-editor-post-finish-hook 'permanent-local t)
(put 'with-editor-post-cancel-hook 'permanent-local t)
(defvar-local with-editor-show-usage t)
(defvar-local with-editor-cancel-message nil)
(defvar-local with-editor-previous-winconf nil)
(put 'with-editor-cancel-message 'permanent-local t)
(put 'with-editor-previous-winconf 'permanent-local t)
(defvar-local with-editor--pid nil "For internal use.")
(put 'with-editor--pid 'permanent-local t)
(defun with-editor-finish (force)
"Finish the current edit session."
(interactive "P")
(when (run-hook-with-args-until-failure
'with-editor-finish-query-functions force)
(let ((post-finish-hook with-editor-post-finish-hook)
(post-commit-hook (bound-and-true-p git-commit-post-finish-hook))
(dir default-directory))
(run-hooks 'with-editor-pre-finish-hook)
(with-editor-return nil)
(accept-process-output nil 0.1)
(with-temp-buffer
(setq default-directory dir)
(setq-local with-editor-post-finish-hook post-finish-hook)
(when post-commit-hook
(setq-local git-commit-post-finish-hook post-commit-hook))
(run-hooks 'with-editor-post-finish-hook)))))
(defun with-editor-cancel (force)
"Cancel the current edit session."
(interactive "P")
(when (run-hook-with-args-until-failure
'with-editor-cancel-query-functions force)
(let ((message with-editor-cancel-message))
(when (functionp message)
(setq message (funcall message)))
(let ((post-cancel-hook with-editor-post-cancel-hook)
(with-editor-cancel-alist nil)
(dir default-directory))
(run-hooks 'with-editor-pre-cancel-hook)
(with-editor-return t)
(accept-process-output nil 0.1)
(with-temp-buffer
(setq default-directory dir)
(setq-local with-editor-post-cancel-hook post-cancel-hook)
(run-hooks 'with-editor-post-cancel-hook)))
(message (or message "Canceled by user")))))
(defun with-editor-return (cancel)
(let ((winconf with-editor-previous-winconf)
(clients server-buffer-clients)
(dir default-directory)
(pid with-editor--pid))
(remove-hook 'kill-buffer-query-functions
#'with-editor-kill-buffer-noop t)
(cond (cancel
(save-buffer)
(if clients
(dolist (client clients)
(ignore-errors
(server-send-string client "-error Canceled by user"))
(delete-process client))
;; Fallback for when emacs was used as $EDITOR
;; instead of emacsclient or the sleeping editor.
;; See https://github.com/magit/magit/issues/2258.
(ignore-errors (delete-file buffer-file-name))
(kill-buffer)))
(t
(save-buffer)
(if clients
;; Don't use `server-edit' because we do not want to
;; show another buffer belonging to another client.
;; See https://github.com/magit/magit/issues/2197.
(server-done)
(kill-buffer))))
(when pid
(let ((default-directory dir))
(process-file "kill" nil nil nil
"-s" (if cancel "USR2" "USR1") pid)))
(when (and winconf (eq (window-configuration-frame winconf)
(selected-frame)))
(set-window-configuration winconf))))
;;; Mode
(defvar with-editor-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\C-c\C-c" #'with-editor-finish)
(define-key map [remap server-edit] #'with-editor-finish)
(define-key map [remap evil-save-and-close] #'with-editor-finish)
(define-key map [remap evil-save-modified-and-close] #'with-editor-finish)
(define-key map "\C-c\C-k" #'with-editor-cancel)
(define-key map [remap kill-buffer] #'with-editor-cancel)
(define-key map [remap ido-kill-buffer] #'with-editor-cancel)
(define-key map [remap iswitchb-kill-buffer] #'with-editor-cancel)
(define-key map [remap evil-quit] #'with-editor-cancel)
map))
(define-minor-mode with-editor-mode
"Edit a file as the $EDITOR of an external process."
:lighter with-editor-mode-lighter
;; Protect the user from killing the buffer without using
;; either `with-editor-finish' or `with-editor-cancel',
;; and from removing the key bindings for these commands.
(unless with-editor-mode
(user-error "With-Editor mode cannot be turned off"))
(add-hook 'kill-buffer-query-functions
#'with-editor-kill-buffer-noop nil t)
;; `server-execute' displays a message which is not
;; correct when using this mode.
(when with-editor-show-usage
(with-editor-usage-message)))
(put 'with-editor-mode 'permanent-local t)
(defun with-editor-kill-buffer-noop ()
;; We started doing this in response to #64, but it is not safe
;; to do so, because the client has already been killed, causing
;; `with-editor-return' (called by `with-editor-cancel') to delete
;; the file, see #66. The reason we delete the file in the first
;; place are https://github.com/magit/magit/issues/2258 and
;; https://github.com/magit/magit/issues/2248.
;; (if (memq this-command '(save-buffers-kill-terminal
;; save-buffers-kill-emacs))
;; (let ((with-editor-cancel-query-functions nil))
;; (with-editor-cancel nil)
;; t)
;; ...)
;; So go back to always doing this instead:
(user-error (substitute-command-keys (format "\
Don't kill this buffer %S. Instead cancel using \\[with-editor-cancel]"
(current-buffer)))))
(defvar-local with-editor-usage-message "\
Type \\[with-editor-finish] to finish, \
or \\[with-editor-cancel] to cancel")
(defun with-editor-usage-message ()
;; Run after `server-execute', which is run using
;; a timer which starts immediately.
(let ((buffer (current-buffer)))
(run-with-timer
0.05 nil
(lambda ()
(with-current-buffer buffer
(message (substitute-command-keys with-editor-usage-message)))))))
;;; Wrappers
(defvar with-editor--envvar nil "For internal use.")
(defmacro with-editor (&rest body)
"Use the Emacsclient as $EDITOR while evaluating BODY.
Modify the `process-environment' for processes started in BODY,
instructing them to use the Emacsclient as $EDITOR. If optional
ENVVAR is a literal string then bind that environment variable
instead.
\n(fn [ENVVAR] BODY...)"
(declare (indent defun) (debug (body)))
`(let ((with-editor--envvar ,(if (stringp (car body))
(pop body)
'(or with-editor--envvar "EDITOR")))
(process-environment process-environment))
(with-editor--setup)
,@body))
(defmacro with-editor* (envvar &rest body)
"Use the Emacsclient as the editor while evaluating BODY.
Modify the `process-environment' for processes started in BODY,
instructing them to use the Emacsclient as editor. ENVVAR is the
environment variable that is exported to do so, it is evaluated
at run-time.
\n(fn [ENVVAR] BODY...)"
(declare (indent defun) (debug (sexp body)))
`(let ((with-editor--envvar ,envvar)
(process-environment process-environment))
(with-editor--setup)
,@body))
(defun with-editor--setup ()
(if (or (not with-editor-emacsclient-executable)
(file-remote-p default-directory))
(push (concat with-editor--envvar "=" with-editor-sleeping-editor)
process-environment)
;; Make sure server-use-tcp's value is valid.
(unless (featurep 'make-network-process '(:family local))
(setq server-use-tcp t))
;; Make sure the server is running.
(unless (process-live-p server-process)
(when (server-running-p server-name)
(setq server-name (format "server%s" (emacs-pid)))
(when (server-running-p server-name)
(server-force-delete server-name)))
(server-start))
;; Tell $EDITOR to use the Emacsclient.
(push (concat with-editor--envvar "="
(shell-quote-argument with-editor-emacsclient-executable)
;; Tell the process where the server file is.
(and (not server-use-tcp)
(concat " --socket-name="
(shell-quote-argument
(expand-file-name server-name
server-socket-dir)))))
process-environment)
(when server-use-tcp
(push (concat "EMACS_SERVER_FILE="
(expand-file-name server-name server-auth-dir))
process-environment))
;; As last resort fallback to the sleeping editor.
(push (concat "ALTERNATE_EDITOR=" with-editor-sleeping-editor)
process-environment)))
(defun with-editor-server-window ()
(or (and buffer-file-name
(cdr (cl-find-if (lambda (cons)
(string-match-p (car cons) buffer-file-name))
with-editor-server-window-alist)))
server-window))
(defun server-switch-buffer--with-editor-server-window-alist
(fn &optional next-buffer &rest args)
"Honor `with-editor-server-window-alist' (which see)."
(let ((server-window (with-current-buffer
(or next-buffer (current-buffer))
(when with-editor-mode
(setq with-editor-previous-winconf
(current-window-configuration)))
(with-editor-server-window))))
(apply fn next-buffer args)))
(advice-add 'server-switch-buffer :around
#'server-switch-buffer--with-editor-server-window-alist)
(defun start-file-process--with-editor-process-filter
(fn name buffer program &rest program-args)
"When called inside a `with-editor' form and the Emacsclient
cannot be used, then give the process the filter function
`with-editor-process-filter'. To avoid overriding the filter
being added here you should use `with-editor-set-process-filter'
instead of `set-process-filter' inside `with-editor' forms.
When the `default-directory' is located on a remote machine,
then also manipulate PROGRAM and PROGRAM-ARGS in order to set
the appropriate editor environment variable."
(if (not with-editor--envvar)
(apply fn name buffer program program-args)
(when (file-remote-p default-directory)
(unless (equal program "env")
(push program program-args)
(setq program "env"))
(push (concat with-editor--envvar "=" with-editor-sleeping-editor)
program-args))
(let ((process (apply fn name buffer program program-args)))
(set-process-filter process #'with-editor-process-filter)
(process-put process 'default-dir default-directory)
process)))
(advice-add 'start-file-process :around
#'start-file-process--with-editor-process-filter)
(cl-defun make-process--with-editor-process-filter
(fn &rest keys &key name buffer command coding noquery stop
connection-type filter sentinel stderr file-handler
&allow-other-keys)
"When called inside a `with-editor' form and the Emacsclient
cannot be used, then give the process the filter function
`with-editor-process-filter'. To avoid overriding the filter
being added here you should use `with-editor-set-process-filter'
instead of `set-process-filter' inside `with-editor' forms.
When the `default-directory' is located on a remote machine and
FILE-HANDLER is non-nil, then also manipulate COMMAND in order
to set the appropriate editor environment variable."
(if (or (not file-handler) (not with-editor--envvar))
(apply fn keys)
(when (file-remote-p default-directory)
(unless (equal (car command) "env")
(push "env" command))
(push (concat with-editor--envvar "=" with-editor-sleeping-editor)
(cdr command)))
(let* ((filter (if filter
(lambda (process output)
(funcall filter process output)
(with-editor-process-filter process output t))
#'with-editor-process-filter))
(process (funcall fn
:name name
:buffer buffer
:command command
:coding coding
:noquery noquery
:stop stop
:connection-type connection-type
:filter filter
:sentinel sentinel
:stderr stderr
:file-handler file-handler)))
(process-put process 'default-dir default-directory)
process)))
(advice-add #'make-process :around #'make-process--with-editor-process-filter)
(defun with-editor-set-process-filter (process filter)
"Like `set-process-filter' but keep `with-editor-process-filter'.
Give PROCESS the new FILTER but keep `with-editor-process-filter'
if that was added earlier by the advised `start-file-process'.
Do so by wrapping the two filter functions using a lambda, which
becomes the actual filter. It calls FILTER first, which may or
may not insert the text into the PROCESS's buffer. Then it calls
`with-editor-process-filter', passing t as NO-STANDARD-FILTER."
(set-process-filter
process
(if (eq (process-filter process) 'with-editor-process-filter)
`(lambda (proc str)
(,filter proc str)
(with-editor-process-filter proc str t))
filter)))
(defvar with-editor-filter-visit-hook nil)
(defconst with-editor-sleeping-editor-regexp
"^WITH-EDITOR: \\([0-9]+\\) OPEN \\([^]+?\\)\\(?: IN \\([^\r]+?\\)\\)?\r?$")
(defvar with-editor--max-incomplete-length 1000)
(defun with-editor-sleeping-editor-filter (process string)
(when-let ((incomplete (and process (process-get process 'incomplete))))
(setq string (concat incomplete string)))
(save-match-data
(cond
((and process (not (string-suffix-p "\n" string)))
(let ((length (length string)))
(when (> length with-editor--max-incomplete-length)
(setq string
(substring string
(- length with-editor--max-incomplete-length)))))
(process-put process 'incomplete string)
nil)
((string-match with-editor-sleeping-editor-regexp string)
(when process
(process-put process 'incomplete nil))
(let ((pid (match-string 1 string))
(file (match-string 2 string))
(dir (match-string 3 string)))
(unless (file-name-absolute-p file)
(setq file (expand-file-name file dir)))
(when default-directory
(setq file (concat (file-remote-p default-directory) file)))
(with-current-buffer (find-file-noselect file)
(with-editor-mode 1)
(setq with-editor--pid pid)
(setq with-editor-previous-winconf
(current-window-configuration))
(run-hooks 'with-editor-filter-visit-hook)
(funcall (or (with-editor-server-window) #'switch-to-buffer)
(current-buffer))
(kill-local-variable 'server-window)))
nil)
(t string))))
(defun with-editor-process-filter
(process string &optional no-default-filter)
"Listen for edit requests by child processes."
(let ((default-directory (process-get process 'default-dir)))
(with-editor-sleeping-editor-filter process string))
(unless no-default-filter
(internal-default-process-filter process string)))
(advice-add 'server-visit-files :after
#'server-visit-files--with-editor-file-name-history-exclude)
(defun server-visit-files--with-editor-file-name-history-exclude
(files _proc &optional _nowait)
(pcase-dolist (`(,file . ,_) files)
(when (cl-find-if (lambda (regexp)
(string-match-p regexp file))
with-editor-file-name-history-exclude)
(setq file-name-history (delete file file-name-history)))))
;;; Augmentations
;;;###autoload
(cl-defun with-editor-export-editor (&optional (envvar "EDITOR"))
"Teach subsequent commands to use current Emacs instance as editor.
Set and export the environment variable ENVVAR, by default
\"EDITOR\". The value is automatically generated to teach
commands to use the current Emacs instance as \"the editor\".
This works in `shell-mode', `term-mode', `eshell-mode' and
`vterm'."
(interactive (list (with-editor-read-envvar)))
(cond
((derived-mode-p 'comint-mode 'term-mode)
(when-let ((process (get-buffer-process (current-buffer))))
(goto-char (process-mark process))
(process-send-string
process (format " export %s=%s\n" envvar
(shell-quote-argument with-editor-sleeping-editor)))
(while (accept-process-output process 0.1))
(if (derived-mode-p 'term-mode)
(with-editor-set-process-filter process #'with-editor-emulate-terminal)
(add-hook 'comint-output-filter-functions #'with-editor-output-filter
nil t))))
((derived-mode-p 'eshell-mode)
(add-to-list 'eshell-preoutput-filter-functions
#'with-editor-output-filter)
(setenv envvar with-editor-sleeping-editor))
((derived-mode-p 'vterm-mode)
(if with-editor-emacsclient-executable
(let ((with-editor--envvar envvar)
(process-environment process-environment))
(with-editor--setup)
(while (accept-process-output vterm--process 0.1))
(when-let ((v (getenv envvar)))
(vterm-send-string (format "export %s=%S" envvar v))
(vterm-send-return))
(when-let ((v (getenv "EMACS_SERVER_FILE")))
(vterm-send-string (format "export EMACS_SERVER_FILE=%S" v))
(vterm-send-return))
(vterm-send-string "clear")
(vterm-send-return))
(error "Cannot use sleeping editor in this buffer")))
(t
(error "Cannot export environment variables in this buffer")))
(message "Successfully exported %s" envvar))
;;;###autoload
(defun with-editor-export-git-editor ()
"Like `with-editor-export-editor' but always set `$GIT_EDITOR'."
(interactive)
(with-editor-export-editor "GIT_EDITOR"))
;;;###autoload
(defun with-editor-export-hg-editor ()
"Like `with-editor-export-editor' but always set `$HG_EDITOR'."
(interactive)
(with-editor-export-editor "HG_EDITOR"))
(defun with-editor-output-filter (string)
"Handle edit requests on behalf of `comint-mode' and `eshell-mode'."
(with-editor-sleeping-editor-filter nil string))
(defun with-editor-emulate-terminal (process string)
"Like `term-emulate-terminal' but also handle edit requests."
(let ((with-editor-sleeping-editor-regexp
(substring with-editor-sleeping-editor-regexp 1)))
(with-editor-sleeping-editor-filter process string))
(term-emulate-terminal process string))
(defvar with-editor-envvars '("EDITOR" "GIT_EDITOR" "HG_EDITOR"))
(cl-defun with-editor-read-envvar
(&optional (prompt "Set environment variable")
(default "EDITOR"))
(let ((reply (completing-read (if default
(format "%s (%s): " prompt default)
(concat prompt ": "))
with-editor-envvars nil nil nil nil default)))
(if (string= reply "") (user-error "Nothing selected") reply)))
;;;###autoload
(define-minor-mode shell-command-with-editor-mode
"Teach `shell-command' to use current Emacs instance as editor.
Teach `shell-command', and all commands that ultimately call that
command, to use the current Emacs instance as editor by executing
\"EDITOR=CLIENT COMMAND&\" instead of just \"COMMAND&\".
CLIENT is automatically generated; EDITOR=CLIENT instructs
COMMAND to use to the current Emacs instance as \"the editor\",
assuming no other variable overrides the effect of \"$EDITOR\".
CLIENT may be the path to an appropriate emacsclient executable
with arguments, or a script which also works over Tramp.
Alternatively you can use the `with-editor-async-shell-command',
which also allows the use of another variable instead of
\"EDITOR\"."
:global t)
;;;###autoload
(defun with-editor-async-shell-command
(command &optional output-buffer error-buffer envvar)
"Like `async-shell-command' but with `$EDITOR' set.
Execute string \"ENVVAR=CLIENT COMMAND\" in an inferior shell;
display output, if any. With a prefix argument prompt for an
environment variable, otherwise the default \"EDITOR\" variable
is used. With a negative prefix argument additionally insert
the COMMAND's output at point.
CLIENT is automatically generated; ENVVAR=CLIENT instructs
COMMAND to use to the current Emacs instance as \"the editor\",
assuming it respects ENVVAR as an \"EDITOR\"-like variable.
CLIENT may be the path to an appropriate emacsclient executable
with arguments, or a script which also works over Tramp.
Also see `async-shell-command' and `shell-command'."
(interactive (with-editor-shell-command-read-args "Async shell command: " t))
(let ((with-editor--envvar envvar))
(with-editor
(async-shell-command command output-buffer error-buffer))))
;;;###autoload
(defun with-editor-shell-command
(command &optional output-buffer error-buffer envvar)
"Like `shell-command' or `with-editor-async-shell-command'.
If COMMAND ends with \"&\" behave like the latter,
else like the former."
(interactive (with-editor-shell-command-read-args "Shell command: "))
(if (string-match "&[ \t]*\\'" command)
(with-editor-async-shell-command
command output-buffer error-buffer envvar)
(shell-command command output-buffer error-buffer)))
(defun with-editor-shell-command-read-args (prompt &optional async)
(let ((command (read-shell-command
prompt nil nil
(let ((filename (or buffer-file-name
(and (eq major-mode 'dired-mode)
(dired-get-filename nil t)))))
(and filename (file-relative-name filename))))))
(list command
(if (or async (setq async (string-match-p "&[ \t]*\\'" command)))
(< (prefix-numeric-value current-prefix-arg) 0)
current-prefix-arg)
shell-command-default-error-buffer
(and async current-prefix-arg (with-editor-read-envvar)))))
(defun shell-command--shell-command-with-editor-mode
(fn command &optional output-buffer error-buffer)
;; `shell-mode' and its hook are intended for buffers in which an
;; interactive shell is running, but `shell-command' also turns on
;; that mode, even though it only runs the shell to run a single
;; command. The `with-editor-export-editor' hook function is only
;; intended to be used in buffers in which an interactive shell is
;; running, so it has to be remove here.
(let ((shell-mode-hook (remove 'with-editor-export-editor shell-mode-hook)))
(cond ((or (not (or with-editor--envvar shell-command-with-editor-mode))
(not (string-suffix-p "&" command)))
(funcall fn command output-buffer error-buffer))
((and with-editor-shell-command-use-emacsclient
with-editor-emacsclient-executable
(not (file-remote-p default-directory)))
(with-editor (funcall fn command output-buffer error-buffer)))
(t
(funcall fn (format "%s=%s %s"
(or with-editor--envvar "EDITOR")
(shell-quote-argument with-editor-sleeping-editor)
command)
output-buffer error-buffer)
(ignore-errors
(let ((process (get-buffer-process
(or output-buffer
(get-buffer "*Async Shell Command*")))))
(set-process-filter
process (lambda (proc str)
(comint-output-filter proc str)
(with-editor-process-filter proc str t)))
process))))))
(advice-add 'shell-command :around
#'shell-command--shell-command-with-editor-mode)
;;; _
(defun with-editor-debug ()
"Debug configuration issues.
See info node `(with-editor)Debugging' for instructions."
(interactive)
(with-current-buffer (get-buffer-create "*with-editor-debug*")
(pop-to-buffer (current-buffer))
(erase-buffer)
(ignore-errors (with-editor))
(insert
(format "with-editor: %s\n" (locate-library "with-editor.el"))
(format "emacs: %s (%s)\n"
(expand-file-name invocation-name invocation-directory)
emacs-version)
"system:\n"
(format " system-type: %s\n" system-type)
(format " system-configuration: %s\n" system-configuration)
(format " system-configuration-options: %s\n" system-configuration-options)
"server:\n"
(format " server-running-p: %s\n" (server-running-p))
(format " server-process: %S\n" server-process)
(format " server-use-tcp: %s\n" server-use-tcp)
(format " server-name: %s\n" server-name)
(format " server-socket-dir: %s\n" server-socket-dir))
(if (and server-socket-dir (file-accessible-directory-p server-socket-dir))
(dolist (file (directory-files server-socket-dir nil "^[^.]"))
(insert (format " %s\n" file)))
(insert (format " %s: not an accessible directory\n"
(if server-use-tcp "WARNING" "ERROR"))))
(insert (format " server-auth-dir: %s\n" server-auth-dir))
(if (file-accessible-directory-p server-auth-dir)
(dolist (file (directory-files server-auth-dir nil "^[^.]"))
(insert (format " %s\n" file)))
(insert (format " %s: not an accessible directory\n"
(if server-use-tcp "ERROR" "WARNING"))))
(let ((val with-editor-emacsclient-executable)
(def (default-value 'with-editor-emacsclient-executable))
(fun (let ((warning-minimum-level :error)
(warning-minimum-log-level :error))
(with-editor-locate-emacsclient))))
(insert "with-editor-emacsclient-executable:\n"
(format " value: %s (%s)\n" val
(and val (with-editor-emacsclient-version val)))
(format " default: %s (%s)\n" def
(and def (with-editor-emacsclient-version def)))
(format " funcall: %s (%s)\n" fun
(and fun (with-editor-emacsclient-version fun)))))
(insert "path:\n"
(format " $PATH: %S\n" (getenv "PATH"))
(format " exec-path: %s\n" exec-path))
(insert (format " with-editor-emacsclient-path:\n"))
(dolist (dir (with-editor-emacsclient-path))
(insert (format " %s (%s)\n" dir (car (file-attributes dir))))
(when (file-directory-p dir)
;; Don't match emacsclientw.exe, it makes popup windows.
(dolist (exec (directory-files dir t "emacsclient\\(?:[^w]\\|\\'\\)"))
(insert (format " %s (%s)\n" exec
(with-editor-emacsclient-version exec))))))))
(defconst with-editor-font-lock-keywords
'(("(\\(with-\\(?:git-\\)?editor\\)\\_>" (1 'font-lock-keyword-face))))
(font-lock-add-keywords 'emacs-lisp-mode with-editor-font-lock-keywords)
(provide 'with-editor)
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
;;; with-editor.el ends here

382
code/elpa/with-editor-20220422.1628/with-editor.info Normal file
View file

@ -0,0 +1,382 @@
This is with-editor.info, produced by makeinfo version 6.7 from
with-editor.texi.
Copyright (C) 2015-2022 Jonas Bernoulli <jonas@bernoul.li>
You can redistribute this document and/or modify it under the terms
of the GNU General Public License as published by the Free Software
Foundation, either version 3 of the License, or (at your option)
any later version.
This document 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.
INFO-DIR-SECTION Emacs
START-INFO-DIR-ENTRY
* With-Editor: (with-editor). Using the Emacsclient as $EDITOR.
END-INFO-DIR-ENTRY

File: with-editor.info, Node: Top, Next: Using the With-Editor package, Up: (dir)
With-Editor User Manual
***********************
The library ‘with-editor’ makes it easy to use the Emacsclient as the
‘$EDITOR’ of child processes, making sure they know how to call home.
For remote processes a substitute is provided, which communicates with
Emacs on standard output instead of using a socket as the Emacsclient
does.
This library was written because Magit has to be able to do the above
to allow the user to edit commit messages gracefully and to edit rebase
sequences, which wouldn’t be possible at all otherwise.
Because other packages can benefit from such functionality, this
library is made available as a separate package. It also defines some
additional functionality which makes it useful even for end-users, who
don’t use Magit or another package which uses it internally.
This manual is for With-Editor version 3.2.0-git.
Copyright (C) 2015-2022 Jonas Bernoulli <jonas@bernoul.li>
You can redistribute this document and/or modify it under the terms
of the GNU General Public License as published by the Free Software
Foundation, either version 3 of the License, or (at your option)
any later version.
This document 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.
* Menu:
* Using the With-Editor package::
* Using With-Editor as a library::
* Debugging::
* Function and Command Index::
* Variable Index::
— The Detailed Node Listing —
Using the With-Editor package
* Configuring With-Editor::
* Using With-Editor commands::

File: with-editor.info, Node: Using the With-Editor package, Next: Using With-Editor as a library, Prev: Top, Up: Top
1 Using the With-Editor package
*******************************
The ‘With-Editor’ package is used internally by Magit when editing
commit messages and rebase sequences. It also provides some commands
and features which are useful by themselves, even if you don’t use
Magit.
For information about using this library in you own package, see
*note Using With-Editor as a library::.
* Menu:
* Configuring With-Editor::
* Using With-Editor commands::

File: with-editor.info, Node: Configuring With-Editor, Next: Using With-Editor commands, Up: Using the With-Editor package
1.1 Configuring With-Editor
===========================
With-Editor tries very hard to locate a suitable ‘emacsclient’
executable, so ideally you should never have to customize the option
‘with-editor-emacsclient-executable’. When it fails to do so, then the
most likely reason is that someone found yet another way to package
Emacs (most likely on macOS) without putting the executable on ‘$PATH’,
and we have to add another kludge to find it anyway.
-- User Option: with-editor-emacsclient-executable
The ‘emacsclient’ executable used as the editor by child process of
this Emacs instance. By using this executable, child processes can
call home to their parent process.
This option is automatically set at startup by looking in
‘exec-path’, and other places where the executable could be
installed, to find the ‘emacsclient’ executable most suitable for
the current Emacs instance.
You should *not* customize this option permanently. If you have to
do it, then you should consider that a temporary kludge and inform
the Magit maintainer as described in *note Debugging::.
If With-Editor fails to find a suitable ‘emacsclient’ on you
system, then this should be fixed for all users at once, by
teaching ‘with-editor-locate-emacsclient’ how to do so on your
system and system like yours. Doing it this way has the advantage,
that you won’t have do it again every time you update Emacs, and
that other users who have installed Emacs the same way as you have,
won’t have to go through the same trouble.
Note that there also is a nuclear option; setting this variable to
‘nil’ causes the "sleeping editor" described below to be used even
for local child processes. Obviously we don’t recommend that you
use this except in "emergencies", i.e. before we had a change to
add a kludge appropriate for you setup.
-- Function: with-editor-locate-emacsclient
The function used to set the initial value of the option
‘with-editor-emacsclient-executable’. There’s a lot of voodoo
here.
The ‘emacsclient’ cannot be used when using Tramp to run a process on
a remote machine. (Theoretically it could, but that would be hard to
setup, very fragile, and rather insecure).
With-Editor provides an alternative "editor" which can be used by
remote processes in much the same way as local processes use an
‘emacsclient’ executable. This alternative is known as the "sleeping
editor" because it is implemented as a shell script which sleeps until
it receives a signal.
-- User Option: with-editor-sleeping-editor
The sleeping editor is a shell script used as the editor of child
processes when the ‘emacsclient’ executable cannot be used.
This fallback is used for asynchronous process started inside the
macro ‘with-editor’, when the process runs on a remote machine or
for local processes when ‘with-editor-emacsclient-executable’ is
‘nil’.
Where the latter uses a socket to communicate with Emacs’ server,
this substitute prints edit requests to its standard output on
which a process filter listens for such requests. As such it is
not a complete substitute for a proper ‘emacsclient’, it can only
be used as ‘$EDITOR’ of child process of the current Emacs
instance.
Some shells do not execute traps immediately when waiting for a
child process, but by default we do use such a blocking child
process.
If you use such a shell (e.g. ‘csh’ on FreeBSD, but not Debian),
then you have to edit this option. You can either replace ‘sh’
with ‘bash’ (and install that), or you can use the older, less
performant implementation:
"sh -c '\
echo \"WITH-EDITOR: $$ OPEN $0 IN $(pwd)\"; \
trap \"exit 0\" USR1; \
trap \"exit 1\" USR2; \
while true; do sleep 1; done'"
Note that the unit separator character () right after the file name
($0) is required.
Also note that using this alternative implementation leads to a
delay of up to a second. The delay can be shortened by replacing
‘sleep 1’ with ‘sleep 0.01’, or if your implementation does not
support floats, then by using ‘nanosleep’ instead.

File: with-editor.info, Node: Using With-Editor commands, Prev: Configuring With-Editor, Up: Using the With-Editor package
1.2 Using With-Editor commands
==============================
This section describes how to use the ‘with-editor’ library _outside_ of
Magit. You don’t need to know any of this just to create commits using
Magit.
The commands ‘with-editor-async-shell-command’ and
‘with-editor-shell-command’ are intended as drop in replacements for
‘async-shell-command’ and ‘shell-command’. They automatically export
‘$EDITOR’ making sure the executed command uses the current Emacs
instance as "the editor". With a prefix argument these commands prompt
for an alternative environment variable such as ‘$GIT_EDITOR’.
-- Command: with-editor-async-shell-command
This command is like ‘async-shell-command’, but it runs the shell
command with the current Emacs instance exported as ‘$EDITOR’.
-- Command: with-editor-shell-command
This command is like ‘shell-command’, but if the shell command ends
with ‘&’ and is therefore run asynchronously, then the current
Emacs instance is exported as ‘$EDITOR’.
To always use these variants add this to you init file:
(define-key (current-global-map)
[remap async-shell-command] 'with-editor-async-shell-command)
(define-key (current-global-map)
[remap shell-command] 'with-editor-shell-command)
Alternatively use the global ‘shell-command-with-editor-mode’.
-- Variable: shell-command-with-editor-mode
When this mode is active, then ‘$EDITOR’ is exported whenever
ultimately ‘shell-command’ is called to asynchronously run some
shell command. This affects most variants of that command, whether
they are defined in Emacs or in some third-party package.
The command ‘with-editor-export-editor’ exports ‘$EDITOR’ or another
such environment variable in ‘shell-mode’, ‘eshell-mode’, ‘term-mode’
and ‘vterm-mode’ buffers. Use this Emacs command before executing a
shell command which needs the editor set, or always arrange for the
current Emacs instance to be used as editor by adding it to the
appropriate mode hooks:
(add-hook 'shell-mode-hook 'with-editor-export-editor)
(add-hook 'eshell-mode-hook 'with-editor-export-editor)
(add-hook 'term-exec-hook 'with-editor-export-editor)
(add-hook 'vterm-exec-hook 'with-editor-export-editor)
Some variants of this function exist; these two forms are equivalent:
(add-hook 'shell-mode-hook
(apply-partially 'with-editor-export-editor "GIT_EDITOR"))
(add-hook 'shell-mode-hook 'with-editor-export-git-editor)
-- Command: with-editor-export-editor
When invoked in a ‘shell-mode’, ‘eshell-mode’, ‘term-mode’ or
‘vterm-mode’ buffer, this command teaches shell commands to use the
current Emacs instance as the editor, by exporting ‘$EDITOR’.
-- Command: with-editor-export-git-editor
This command is like ‘with-editor-export-editor’ but exports
‘$GIT_EDITOR’.
-- Command: with-editor-export-hg-editor
This command is like ‘with-editor-export-editor’ but exports
‘$HG_EDITOR’.

File: with-editor.info, Node: Using With-Editor as a library, Next: Debugging, Prev: Using the With-Editor package, Up: Top
2 Using With-Editor as a library
********************************
This section describes how to use the ‘with-editor’ library _outside_ of
Magit to teach another package how to have its child processes call
home, just like Magit does. You don’t need to know any of this just to
create commits using Magit. You can also ignore this if you use
‘with-editor’ outside of Magit, but only as an end-user.
For information about interactive use and options that affect both
interactive and non-interactive use, see *note Using the With-Editor
package::.
-- Macro: with-editor &rest body
This macro arranges for the ‘emacsclient’ or the sleeping editor to
be used as the editor of child processes, effectively teaching them
to call home to the current Emacs instance when they require that
the user edits a file.
This is done by establishing a local binding for
‘process-environment’ and changing the value of the ‘EDITOR’
environment variable in that scope. This affects all
(asynchronous) processes started by forms (dynamically) inside
BODY.
If BODY begins with a literal string, then that variable is set
instead of ‘EDITOR’.
-- Macro: with-editor envvar &rest body
This macro is like ‘with-editor’ instead that the ENVVAR argument
is required and that it is evaluated at run-time.
-- Function: with-editor-set-process-filter process filter
This function is like ‘set-process-filter’ but ensures that adding
the new FILTER does not remove the ‘with-editor-process-filter’.
This is done by wrapping the two filter functions using a lambda,
which becomes the actual filter. It calls FILTER first, which may
or may not insert the text into the PROCESS’s buffer. Then it
calls ‘with-editor-process-filter’, passing t as
NO-STANDARD-FILTER.

File: with-editor.info, Node: Debugging, Next: Function and Command Index, Prev: Using With-Editor as a library, Up: Top
3 Debugging
***********
With-Editor tries very hard to locate a suitable ‘emacsclient’
executable, and then sets option ‘with-editor-emacsclient-executable’
accordingly. In very rare cases this fails. When it does fail, then
the most likely reason is that someone found yet another way to package
Emacs (most likely on macOS) without putting the executable on ‘$PATH’,
and we have to add another kludge to find it anyway.
If you are having problems using ‘with-editor’, e.g. you cannot
commit in Magit, then please open a new issue at
<https://github.com/magit/with-editor/issues> and provide information
about your Emacs installation. Most importantly how did you install
Emacs and what is the output of ‘M-x with-editor-debug RET’.

File: with-editor.info, Node: Function and Command Index, Next: Variable Index, Prev: Debugging, Up: Top
Appendix A Function and Command Index
*************************************
[index]
* Menu:
* with-editor: Using With-Editor as a library.
(line 16)
* with-editor <1>: Using With-Editor as a library.
(line 31)
* with-editor-async-shell-command: Using With-Editor commands.
(line 17)
* with-editor-export-editor: Using With-Editor commands.
(line 59)
* with-editor-export-git-editor: Using With-Editor commands.
(line 64)
* with-editor-export-hg-editor: Using With-Editor commands.
(line 68)
* with-editor-locate-emacsclient: Configuring With-Editor.
(line 41)
* with-editor-set-process-filter: Using With-Editor as a library.
(line 35)
* with-editor-shell-command: Using With-Editor commands.
(line 21)

File: with-editor.info, Node: Variable Index, Prev: Function and Command Index, Up: Top
Appendix B Variable Index
*************************
[index]
* Menu:
* shell-command-with-editor-mode: Using With-Editor commands.
(line 35)
* with-editor-emacsclient-executable: Configuring With-Editor.
(line 13)
* with-editor-sleeping-editor: Configuring With-Editor.
(line 56)

Tag Table:
Node: Top773
Node: Using the With-Editor package2567
Node: Configuring With-Editor3153
Node: Using With-Editor commands7699
Node: Using With-Editor as a library10984
Node: Debugging13009
Node: Function and Command Index13901
Node: Variable Index15399

End Tag Table

Local Variables:
coding: utf-8
End:

1
org/elpa/compat-28.1.1.0.signed Normal file
View file

@ -0,0 +1 @@
Good signature from 066DAFCB81E42C40 GNU ELPA Signing Agent (2019) <elpasign@elpa.gnu.org> (trust undefined) created at 2022-04-22T17:05:01-0400 using RSA

40
org/elpa/compat-28.1.1.0/NEWS.org Normal file
View file

@ -0,0 +1,40 @@
* Release of "Compat" Version 28.1.1.0
This release mostly fixes a number of smaller bugs that were not
identified as of 28.1.0.0. Nevertheless these warrent a version bump,
as some of these changes a functional. These include:
- The addition of the =file-attribute-*= accessor functions.
- The addition of =file-attribute-collect=.
- Improvements to the Texinfo manual (via Jonas Bernoulli's recent
work on =ox-texinfo=). For the time being, the Texinfo file is
maintained in the repository itself, next to the =MANUAL= file.
This might change in the future.
- Adding a prefix to =string-trim=, =string-trim-left= and
=string-trim-right= (i.e. now =compat-string-trim=,
=compat-string-trim-left= and =compat-string-trim-right=)
- Improving the version inference used in the =compat-*= macros.
This improves the compile-time optimisation that strips away
functions that are known to be defined for a specific version.
- The addition of generalised variable (=setf=) support for
=compat-alist-get=.
- The addition of =image-property= and generalised variable support
for =image-property=.
- The addition of the function =compat-executable-find=.
- The addition of the function =compat-dired-get-marked-files=.
- The addition of the function =exec-path=.
- The addition of the function =make-lock-file-name=.
- The addition of the function =null-device=.
- The addition of the function =time-equal-p=.
- The addition of the function =date-days-in-month=.
- Handling out-of-directory byte compilation better.
- Fixing the usage and edge-cases of =and-let*=.
Furthermore a bug tracker was added: https://todo.sr.ht/~pkal/compat,
which is the preferred way to report issues or feature requests.
General problems, questions, etc. are still better discussed on the
development mailing list: https://lists.sr.ht/~pkal/compat-devel.
(Released <2022-04-22 Fri>)

516
org/elpa/compat-28.1.1.0/compat-24.el Normal file
View file

@ -0,0 +1,516 @@
;;; compat-24.el --- Compatibility Layer for Emacs 24.4 -*- lexical-binding: t; -*-
;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
;; Author: Philip Kaludercic <philipk@posteo.net>
;; Maintainer: Compat Development <~pkal/compat-devel@lists.sr.ht>
;; URL: https://git.sr.ht/~pkal/compat/
;; Keywords: lisp
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Find here the functionality added in Emacs 24.4, needed by older
;; versions.
;;
;; Do NOT load this library manually. Instead require `compat'.
;;; Code:
(eval-when-compile (require 'compat-macs))
;;;; Defined in data.c
(compat-defun = (number-or-marker &rest numbers-or-markers)
"Handle multiple arguments."
:version "24.4"
:prefix t
(catch 'fail
(while numbers-or-markers
(unless (= number-or-marker (car numbers-or-markers))
(throw 'fail nil))
(setq number-or-marker (pop numbers-or-markers)))
t))
(compat-defun < (number-or-marker &rest numbers-or-markers)
"Handle multiple arguments."
:version "24.4"
:prefix t
(catch 'fail
(while numbers-or-markers
(unless (< number-or-marker (car numbers-or-markers))
(throw 'fail nil))
(setq number-or-marker (pop numbers-or-markers)))
t))
(compat-defun > (number-or-marker &rest numbers-or-markers)
"Handle multiple arguments."
:version "24.4"
:prefix t
(catch 'fail
(while numbers-or-markers
(unless (> number-or-marker (car numbers-or-markers))
(throw 'fail nil))
(setq number-or-marker (pop numbers-or-markers)))
t))
(compat-defun <= (number-or-marker &rest numbers-or-markers)
"Handle multiple arguments."
:version "24.4"
:prefix t
(catch 'fail
(while numbers-or-markers
(unless (<= number-or-marker (car numbers-or-markers))
(throw 'fail nil))
(setq number-or-marker (pop numbers-or-markers)))
t))
(compat-defun >= (number-or-marker &rest numbers-or-markers)
"Handle multiple arguments."
:version "24.4"
:prefix t
(catch 'fail
(while numbers-or-markers
(unless (>= number-or-marker (pop numbers-or-markers))
(throw 'fail nil)))
t))
(compat-defun bool-vector-exclusive-or (a b &optional c)
"Return A ^ B, bitwise exclusive or.
If optional third argument C is given, store result into C.
A, B, and C must be bool vectors of the same length.
Return the destination vector if it changed or nil otherwise."
:version "24.4"
(unless (bool-vector-p a)
(signal 'wrong-type-argument (list 'bool-vector-p a)))
(unless (bool-vector-p b)
(signal 'wrong-type-argument (list 'bool-vector-p b)))
(unless (or (null c) (bool-vector-p c))
(signal 'wrong-type-argument (list 'bool-vector-p c)))
(when (/= (length a) (length b))
(signal 'wrong-length-argument (list (length a) (length b))))
(let ((dest (or c (make-bool-vector (length a) nil))) changed)
(when (/= (length a) (length dest))
(signal 'wrong-length-argument (list (length a) (length dest))))
(dotimes (i (length dest))
(let ((val (not (eq (aref a i) (aref b i)))))
(unless (eq val (aref dest i))
(setq changed t))
(aset dest i val)))
(if c (and changed c) dest)))
(compat-defun bool-vector-union (a b &optional c)
"Return A | B, bitwise or.
If optional third argument C is given, store result into C.
A, B, and C must be bool vectors of the same length.
Return the destination vector if it changed or nil otherwise."
:version "24.4"
(unless (bool-vector-p a)
(signal 'wrong-type-argument (list 'bool-vector-p a)))
(unless (bool-vector-p b)
(signal 'wrong-type-argument (list 'bool-vector-p b)))
(unless (or (null c) (bool-vector-p c))
(signal 'wrong-type-argument (list 'bool-vector-p c)))
(when (/= (length a) (length b))
(signal 'wrong-length-argument (list (length a) (length b))))
(let ((dest (or c (make-bool-vector (length a) nil))) changed)
(when (/= (length a) (length dest))
(signal 'wrong-length-argument (list (length a) (length dest))))
(dotimes (i (length dest))
(let ((val (or (aref a i) (aref b i))))
(unless (eq val (aref dest i))
(setq changed t))
(aset dest i val)))
(if c (and changed c) dest)))
(compat-defun bool-vector-intersection (a b &optional c)
"Return A & B, bitwise and.
If optional third argument C is given, store result into C.
A, B, and C must be bool vectors of the same length.
Return the destination vector if it changed or nil otherwise."
:version "24.4"
(unless (bool-vector-p a)
(signal 'wrong-type-argument (list 'bool-vector-p a)))
(unless (bool-vector-p b)
(signal 'wrong-type-argument (list 'bool-vector-p b)))
(unless (or (null c) (bool-vector-p c))
(signal 'wrong-type-argument (list 'bool-vector-p c)))
(when (/= (length a) (length b))
(signal 'wrong-length-argument (list (length a) (length b))))
(let ((dest (or c (make-bool-vector (length a) nil))) changed)
(when (/= (length a) (length dest))
(signal 'wrong-length-argument (list (length a) (length dest))))
(dotimes (i (length dest))
(let ((val (and (aref a i) (aref b i))))
(unless (eq val (aref dest i))
(setq changed t))
(aset dest i val)))
(if c (and changed c) dest)))
(compat-defun bool-vector-set-difference (a b &optional c)
"Return A &~ B, set difference.
If optional third argument C is given, store result into C.
A, B, and C must be bool vectors of the same length.
Return the destination vector if it changed or nil otherwise."
:version "24.4"
(unless (bool-vector-p a)
(signal 'wrong-type-argument (list 'bool-vector-p a)))
(unless (bool-vector-p b)
(signal 'wrong-type-argument (list 'bool-vector-p b)))
(unless (or (null c) (bool-vector-p c))
(signal 'wrong-type-argument (list 'bool-vector-p c)))
(when (/= (length a) (length b))
(signal 'wrong-length-argument (list (length a) (length b))))
(let ((dest (or c (make-bool-vector (length a) nil))) changed)
(when (/= (length a) (length dest))
(signal 'wrong-length-argument (list (length a) (length dest))))
(dotimes (i (length dest))
(let ((val (and (aref a i) (not (aref b i)))))
(unless (eq val (aref dest i))
(setq changed t))
(aset dest i val)))
(if c (and changed c) dest)))
(compat-defun bool-vector-not (a &optional b)
"Compute ~A, set complement.
If optional second argument B is given, store result into B.
A and B must be bool vectors of the same length.
Return the destination vector."
:version "24.4"
(unless (bool-vector-p a)
(signal 'wrong-type-argument (list 'bool-vector-p a)))
(unless (or (null b) (bool-vector-p b))
(signal 'wrong-type-argument (list 'bool-vector-p b)))
(let ((dest (or b (make-bool-vector (length a) nil))))
(when (/= (length a) (length dest))
(signal 'wrong-length-argument (list (length a) (length dest))))
(dotimes (i (length dest))
(aset dest i (not (aref a i))))
dest))
(compat-defun bool-vector-subsetp (a b)
"Return t if every t value in A is also t in B, nil otherwise.
A and B must be bool vectors of the same length."
:version "24.4"
(unless (bool-vector-p a)
(signal 'wrong-type-argument (list 'bool-vector-p a)))
(unless (bool-vector-p b)
(signal 'wrong-type-argument (list 'bool-vector-p b)))
(when (/= (length a) (length b))
(signal 'wrong-length-argument (list (length a) (length b))))
(catch 'not-subset
(dotimes (i (length a))
(when (if (aref a i) (not (aref b i)) nil)
(throw 'not-subset nil)))
t))
(compat-defun bool-vector-count-consecutive (a b i)
"Count how many consecutive elements in A equal B starting at I.
A is a bool vector, B is t or nil, and I is an index into A."
:version "24.4"
(unless (bool-vector-p a)
(signal 'wrong-type-argument (list 'bool-vector-p a)))
(setq b (and b t)) ;normalise to nil or t
(unless (< i (length a))
(signal 'args-out-of-range (list a i)))
(let ((len (length a)) (n i))
(while (and (< i len) (eq (aref a i) b))
(setq i (1+ i)))
(- i n)))
(compat-defun bool-vector-count-population (a)
"Count how many elements in A are t.
A is a bool vector. To count A's nil elements, subtract the
return value from A's length."
:version "24.4"
(unless (bool-vector-p a)
(signal 'wrong-type-argument (list 'bool-vector-p a)))
(let ((n 0))
(dotimes (i (length a))
(when (aref a i)
(setq n (1+ n))))
n))
;;;; Defined in subr.el
;;* UNTESTED
(compat-defmacro with-eval-after-load (file &rest body)
"Execute BODY after FILE is loaded.
FILE is normally a feature name, but it can also be a file name,
in case that file does not provide any feature. See `eval-after-load'
for more details about the different forms of FILE and their semantics."
:version "24.4"
(declare (indent 1) (debug (form def-body)))
;; See https://nullprogram.com/blog/2018/02/22/ on how
;; `eval-after-load' is used to preserve compatibility with 24.3.
`(eval-after-load ,file `(funcall ',,`(lambda () ,@body))))
(compat-defun special-form-p (object)
"Non-nil if and only if OBJECT is a special form."
:version "24.4"
(if (and (symbolp object) (fboundp object))
(setq object (condition-case nil
(indirect-function object)
(void-function nil))))
(and (subrp object) (eq (cdr (subr-arity object)) 'unevalled)))
(compat-defun macrop (object)
"Non-nil if and only if OBJECT is a macro."
:version "24.4"
(let ((def (condition-case nil
(indirect-function object)
(void-function nil))))
(when (consp def)
(or (eq 'macro (car def))
(and (autoloadp def) (memq (nth 4 def) '(macro t)))))))
(compat-defun string-suffix-p (suffix string &optional ignore-case)
"Return non-nil if SUFFIX is a suffix of STRING.
If IGNORE-CASE is non-nil, the comparison is done without paying
attention to case differences."
:version "24.4"
(let ((start-pos (- (length string) (length suffix))))
(and (>= start-pos 0)
(eq t (compare-strings suffix nil nil
string start-pos nil ignore-case)))))
(compat-defun split-string (string &optional separators omit-nulls trim)
"Extend `split-string' by a TRIM argument.
The remaining arguments STRING, SEPARATORS and OMIT-NULLS are
handled just as with `split-string'."
:version "24.4"
:prefix t
(let* ((token (split-string string separators omit-nulls))
(trimmed (if trim
(mapcar
(lambda (token)
(when (string-match (concat "\\`" trim) token)
(setq token (substring token (match-end 0))))
(when (string-match (concat trim "\\'") token)
(setq token (substring token 0 (match-beginning 0))))
token)
token)
token)))
(if omit-nulls (delete "" trimmed) trimmed)))
(compat-defun delete-consecutive-dups (list &optional circular)
"Destructively remove `equal' consecutive duplicates from LIST.
First and last elements are considered consecutive if CIRCULAR is
non-nil."
:version "24.4"
(let ((tail list) last)
(while (cdr tail)
(if (equal (car tail) (cadr tail))
(setcdr tail (cddr tail))
(setq last tail
tail (cdr tail))))
(if (and circular
last
(equal (car tail) (car list)))
(setcdr last nil)))
list)
;;* UNTESTED
(compat-defun define-error (name message &optional parent)
"Define NAME as a new error signal.
MESSAGE is a string that will be output to the echo area if such an error
is signaled without being caught by a `condition-case'.
PARENT is either a signal or a list of signals from which it inherits.
Defaults to `error'."
:version "24.4"
(unless parent (setq parent 'error))
(let ((conditions
(if (consp parent)
(apply #'append
(mapcar (lambda (parent)
(cons parent
(or (get parent 'error-conditions)
(error "Unknown signal `%s'" parent))))
parent))
(cons parent (get parent 'error-conditions)))))
(put name 'error-conditions
(delete-dups (copy-sequence (cons name conditions))))
(when message (put name 'error-message message))))
;;;; Defined in minibuffer.el
;;* UNTESTED
(compat-defun completion-table-with-cache (fun &optional ignore-case)
"Create dynamic completion table from function FUN, with cache.
This is a wrapper for `completion-table-dynamic' that saves the last
argument-result pair from FUN, so that several lookups with the
same argument (or with an argument that starts with the first one)
only need to call FUN once. This can be useful when FUN performs a
relatively slow operation, such as calling an external process.
When IGNORE-CASE is non-nil, FUN is expected to be case-insensitive."
:version "24.4"
(let* (last-arg last-result
(new-fun
(lambda (arg)
(if (and last-arg (string-prefix-p last-arg arg ignore-case))
last-result
(prog1
(setq last-result (funcall fun arg))
(setq last-arg arg))))))
(completion-table-dynamic new-fun)))
;;* UNTESTED
(compat-defun completion-table-merge (&rest tables)
"Create a completion table that collects completions from all TABLES."
:version "24.4"
(lambda (string pred action)
(cond
((null action)
(let ((retvals (mapcar (lambda (table)
(try-completion string table pred))
tables)))
(if (member string retvals)
string
(try-completion string
(mapcar (lambda (value)
(if (eq value t) string value))
(delq nil retvals))
pred))))
((eq action t)
(apply #'append (mapcar (lambda (table)
(all-completions string table pred))
tables)))
(t
(completion--some (lambda (table)
(complete-with-action action table string pred))
tables)))))
;;;; Defined in subr-x.el
;;* UNTESTED
(compat-advise require (feature &rest args)
"Allow for Emacs 24.x to require the inexistent FEATURE subr-x."
:version "24.4"
;; As the compatibility advise around `require` is more a hack than
;; of of actual value, the highlighting is suppressed.
:no-highlight t
(if (eq feature 'subr-x)
(let ((entry (assq feature after-load-alist)))
(let ((load-file-name nil))
(dolist (form (cdr entry))
(funcall (eval form t)))))
(apply oldfun feature args)))
(compat-defun hash-table-keys (hash-table)
"Return a list of keys in HASH-TABLE."
:version "24.4"
(let (values)
(maphash
(lambda (k _v) (push k values))
hash-table)
values))
(compat-defun hash-table-values (hash-table)
"Return a list of values in HASH-TABLE."
:version "24.4"
(let (values)
(maphash
(lambda (_k v) (push v values))
hash-table)
values))
(compat-defun string-empty-p (string)
"Check whether STRING is empty."
:version "24.4"
(string= string ""))
(compat-defun string-join (strings &optional separator)
"Join all STRINGS using SEPARATOR.
Optional argument SEPARATOR must be a string, a vector, or a list of
characters; nil stands for the empty string."
:version "24.4"
(mapconcat #'identity strings separator))
(compat-defun string-blank-p (string)
"Check whether STRING is either empty or only whitespace.
The following characters count as whitespace here: space, tab, newline and
carriage return."
:version "24.4"
(string-match-p "\\`[ \t\n\r]*\\'" string))
(compat-defun string-remove-prefix (prefix string)
"Remove PREFIX from STRING if present."
:version "24.4"
(if (string-prefix-p prefix string)
(substring string (length prefix))
string))
(compat-defun string-remove-suffix (suffix string)
"Remove SUFFIX from STRING if present."
:version "24.4"
(if (string-suffix-p suffix string)
(substring string 0 (- (length string) (length suffix)))
string))
;;;; Defined in faces.el
;;* UNTESTED
(compat-defun face-spec-set (face spec &optional spec-type)
"Set the FACE's spec SPEC, define FACE, and recalculate its attributes.
See `defface' for the format of SPEC.
The appearance of each face is controlled by its specs (set via
this function), and by the internal frame-specific face
attributes (set via `set-face-attribute').
This function also defines FACE as a valid face name if it is not
already one, and (re)calculates its attributes on existing
frames.
The optional argument SPEC-TYPE determines which spec to set:
nil, omitted or `face-override-spec' means the override spec,
which overrides all the other types of spec mentioned below
(this is usually what you want if calling this function
outside of Custom code);
`customized-face' or `saved-face' means the customized spec or
the saved custom spec;
`face-defface-spec' means the default spec
(usually set only via `defface');
`reset' means to ignore SPEC, but clear the `customized-face'
and `face-override-spec' specs;
Any other value means not to set any spec, but to run the
function for defining FACE and recalculating its attributes."
:version "24.4"
(if (get face 'face-alias)
(setq face (get face 'face-alias)))
;; Save SPEC to the relevant symbol property.
(unless spec-type
(setq spec-type 'face-override-spec))
(if (memq spec-type '(face-defface-spec face-override-spec
customized-face saved-face))
(put face spec-type spec))
(if (memq spec-type '(reset saved-face))
(put face 'customized-face nil))
;; Setting the face spec via Custom empties out any override spec,
;; similar to how setting a variable via Custom changes its values.
(if (memq spec-type '(customized-face saved-face reset))
(put face 'face-override-spec nil))
;; If we reset the face based on its custom spec, it is unmodified
;; as far as Custom is concerned.
(unless (eq face 'face-override-spec)
(put face 'face-modified nil))
;; Initialize the face if it does not exist, then recalculate.
(make-empty-face face)
(dolist (frame (frame-list))
(face-spec-recalc face frame)))
(provide 'compat-24)
;;; compat-24.el ends here

317
org/elpa/compat-28.1.1.0/compat-25.el Normal file
View file

@ -0,0 +1,317 @@
;;; compat-25.el --- Compatibility Layer for Emacs 25.1 -*- lexical-binding: t; -*-
;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
;; Author: Philip Kaludercic <philipk@posteo.net>
;; Maintainer: Compat Development <~pkal/compat-devel@lists.sr.ht>
;; URL: https://git.sr.ht/~pkal/compat/
;; Keywords: lisp
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Find here the functionality added in Emacs 25.1, needed by older
;; versions.
;;
;; Do NOT load this library manually. Instead require `compat'.
;;; Code:
(eval-when-compile (require 'compat-macs))
;;;; Defined in alloc.c
(compat-defun bool-vector (&rest objects)
"Return a new bool-vector with specified arguments as elements.
Allows any number of arguments, including zero.
usage: (bool-vector &rest OBJECTS)"
(let ((vec (make-bool-vector (length objects) nil))
(i 0))
(while objects
(when (car objects)
(aset vec i t))
(setq objects (cdr objects)
i (1+ i)))
vec))
;;;; Defined in fns.c
(compat-defun sort (seq predicate)
"Extend `sort' to sort SEQ as a vector."
:prefix t
(cond
((listp seq)
(sort seq predicate))
((vectorp seq)
(let ((cseq (sort (append seq nil) predicate)))
(dotimes (i (length cseq))
(setf (aref seq i) (nth i cseq)))
(apply #'vector cseq)))
((signal 'wrong-type-argument 'list-or-vector-p))))
;;;; Defined in editfns.c
(compat-defun format-message (string &rest objects)
"Format a string out of a format-string and arguments.
The first argument is a format control string.
The other arguments are substituted into it to make the result, a string.
This implementation is equivalent to `format'."
(apply #'format string objects))
;;;; Defined in minibuf.c
;; TODO advise read-buffer to handle 4th argument
;;;; Defined in fileio.c
(compat-defun directory-name-p (name)
"Return non-nil if NAME ends with a directory separator character."
:realname compat--directory-name-p
(eq (eval-when-compile
(if (memq system-type '(cygwin windows-nt ms-dos))
?\\ ?/))
(aref name (1- (length name)))))
;;;; Defined in subr.el
(compat-defun string-greaterp (string1 string2)
"Return non-nil if STRING1 is greater than STRING2 in lexicographic order.
Case is significant.
Symbols are also allowed; their print names are used instead."
(string-lessp string2 string1))
;;* UNTESTED
(compat-defmacro with-file-modes (modes &rest body)
"Execute BODY with default file permissions temporarily set to MODES.
MODES is as for `set-default-file-modes'."
(declare (indent 1) (debug t))
(let ((umask (make-symbol "umask")))
`(let ((,umask (default-file-modes)))
(unwind-protect
(progn
(set-default-file-modes ,modes)
,@body)
(set-default-file-modes ,umask)))))
(compat-defun alist-get (key alist &optional default remove testfn)
"Find the first element of ALIST whose `car' equals KEY and return its `cdr'.
If KEY is not found in ALIST, return DEFAULT.
Equality with KEY is tested by TESTFN, defaulting to `eq'."
:realname compat--alist-get-full-elisp
(ignore remove)
(let (entry)
(cond
((or (null testfn) (eq testfn 'eq))
(setq entry (assq key alist)))
((eq testfn 'equal)
(setq entry (assoc key alist)))
((catch 'found
(dolist (ent alist)
(when (and (consp ent) (funcall testfn (car ent) key))
(throw 'found (setq entry ent))))
default)))
(if entry (cdr entry) default)))
;;;; Defined in subr-x.el
(compat-defmacro if-let (spec then &rest else)
"Bind variables according to SPEC and evaluate THEN or ELSE.
Evaluate each binding in turn, as in `let*', stopping if a
binding value is nil. If all are non-nil return the value of
THEN, otherwise the last form in ELSE.
Each element of SPEC is a list (SYMBOL VALUEFORM) that binds
SYMBOL to the value of VALUEFORM. An element can additionally be
of the form (VALUEFORM), which is evaluated and checked for nil;
i.e. SYMBOL can be omitted if only the test result is of
interest. It can also be of the form SYMBOL, then the binding of
SYMBOL is checked for nil.
As a special case, interprets a SPEC of the form \(SYMBOL SOMETHING)
like \((SYMBOL SOMETHING)). This exists for backward compatibility
with an old syntax that accepted only one binding."
:realname compat--if-let
:feature 'subr-x
(declare (indent 2)
(debug ([&or (symbolp form)
(&rest [&or symbolp (symbolp form) (form)])]
body)))
(when (and (<= (length spec) 2)
(not (listp (car spec))))
;; Adjust the single binding case
(setq spec (list spec)))
`(compat--if-let* ,spec ,then ,(macroexp-progn else)))
(compat-defmacro when-let (spec &rest body)
"Bind variables according to SPEC and conditionally evaluate BODY.
Evaluate each binding in turn, stopping if a binding value is nil.
If all are non-nil, return the value of the last form in BODY.
The variable list SPEC is the same as in `if-let'."
:feature 'subr-x
(declare (indent 1) (debug if-let))
`(compat--if-let ,spec ,(macroexp-progn body)))
(compat-defmacro thread-first (&rest forms)
"Thread FORMS elements as the first argument of their successor.
Example:
(thread-first
5
(+ 20)
(/ 25)
-
(+ 40))
Is equivalent to:
(+ (- (/ (+ 5 20) 25)) 40)
Note how the single `-' got converted into a list before
threading."
:feature 'subr-x
(declare (indent 1)
(debug (form &rest [&or symbolp (sexp &rest form)])))
(let ((body (car forms)))
(dolist (form (cdr forms))
(when (symbolp form)
(setq form (list form)))
(setq body (append (list (car form))
(list body)
(cdr form))))
body))
(compat-defmacro thread-last (&rest forms)
"Thread FORMS elements as the last argument of their successor.
Example:
(thread-last
5
(+ 20)
(/ 25)
-
(+ 40))
Is equivalent to:
(+ 40 (- (/ 25 (+ 20 5))))
Note how the single `-' got converted into a list before
threading."
:feature 'subr-x
(declare (indent 1) (debug thread-first))
(let ((body (car forms)))
(dolist (form (cdr forms))
(when (symbolp form)
(setq form (list form)))
(setq body (append form (list body))))
body))
;;;; Defined in macroexp.el
(declare-function macrop nil (object))
(compat-defun macroexpand-1 (form &optional environment)
"Perform (at most) one step of macro expansion."
:feature 'macroexp
(cond
((consp form)
(let* ((head (car form))
(env-expander (assq head environment)))
(if env-expander
(if (cdr env-expander)
(apply (cdr env-expander) (cdr form))
form)
(if (not (and (symbolp head) (fboundp head)))
form
(let ((def (autoload-do-load (symbol-function head) head 'macro)))
(cond
;; Follow alias, but only for macros, otherwise we may end up
;; skipping an important compiler-macro (e.g. cl--block-wrapper).
((and (symbolp def) (macrop def)) (cons def (cdr form)))
((not (consp def)) form)
(t
(if (eq 'macro (car def))
(apply (cdr def) (cdr form))
form))))))))
(t form)))
;;;; Defined in byte-run.el
;;* UNTESTED
(compat-defun function-put (func prop value)
"Set FUNCTION's property PROP to VALUE.
The namespace for PROP is shared with symbols.
So far, FUNCTION can only be a symbol, not a lambda expression."
:version "24.4"
(put func prop value))
;;;; Defined in files.el
;;* UNTESTED
(compat-defun directory-files-recursively
(dir regexp &optional include-directories predicate follow-symlinks)
"Return list of all files under directory DIR whose names match REGEXP.
This function works recursively. Files are returned in \"depth
first\" order, and files from each directory are sorted in
alphabetical order. Each file name appears in the returned list
in its absolute form.
By default, the returned list excludes directories, but if
optional argument INCLUDE-DIRECTORIES is non-nil, they are
included.
PREDICATE can be either nil (which means that all subdirectories
of DIR are descended into), t (which means that subdirectories that
can't be read are ignored), or a function (which is called with
the name of each subdirectory, and should return non-nil if the
subdirectory is to be descended into).
If FOLLOW-SYMLINKS is non-nil, symbolic links that point to
directories are followed. Note that this can lead to infinite
recursion."
:realname compat--directory-files-recursively
(let* ((result nil)
(files nil)
(dir (directory-file-name dir))
;; When DIR is "/", remote file names like "/method:" could
;; also be offered. We shall suppress them.
(tramp-mode (and tramp-mode (file-remote-p (expand-file-name dir)))))
(dolist (file (sort (file-name-all-completions "" dir)
'string<))
(unless (member file '("./" "../"))
(if (directory-name-p file)
(let* ((leaf (substring file 0 (1- (length file))))
(full-file (concat dir "/" leaf)))
;; Don't follow symlinks to other directories.
(when (and (or (not (file-symlink-p full-file))
(and (file-symlink-p full-file)
follow-symlinks))
;; Allow filtering subdirectories.
(or (eq predicate nil)
(eq predicate t)
(funcall predicate full-file)))
(let ((sub-files
(if (eq predicate t)
(condition-case nil
(compat--directory-files-recursively
full-file regexp include-directories
predicate follow-symlinks)
(file-error nil))
(compat--directory-files-recursively
full-file regexp include-directories
predicate follow-symlinks))))
(setq result (nconc result sub-files))))
(when (and include-directories
(string-match regexp leaf))
(setq result (nconc result (list full-file)))))
(when (string-match regexp file)
(push (concat dir "/" file) files)))))
(nconc result (nreverse files))))
(provide 'compat-25)
;;; compat-25.el ends here

623
org/elpa/compat-28.1.1.0/compat-26.el Normal file
View file

@ -0,0 +1,623 @@
;;; compat-26.el --- Compatibility Layer for Emacs 26.1 -*- lexical-binding: t; -*-
;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
;; Author: Philip Kaludercic <philipk@posteo.net>
;; Maintainer: Compat Development <~pkal/compat-devel@lists.sr.ht>
;; URL: https://git.sr.ht/~pkal/compat/
;; Keywords: lisp
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Find here the functionality added in Emacs 26.1, needed by older
;; versions.
;;
;; Do NOT load this library manually. Instead require `compat'.
;;; Code:
(eval-when-compile (require 'compat-macs))
(declare-function compat-func-arity "compat" (func))
;;;; Defined in eval.c
(compat-defun func-arity (func)
"Return minimum and maximum number of args allowed for FUNC.
FUNC must be a function of some kind.
The returned value is a cons cell (MIN . MAX). MIN is the minimum number
of args. MAX is the maximum number, or the symbol ‘many’, for a
function with ‘&rest’ args, or ‘unevalled’ for a special form."
:realname compat--func-arity
(cond
((or (null func) (and (symbolp func) (not (fboundp func))))
(signal 'void-function func))
((and (symbolp func) (not (null func)))
(compat--func-arity (symbol-function func)))
((eq (car-safe func) 'macro)
(compat--func-arity (cdr func)))
((subrp func)
(subr-arity func))
((memq (car-safe func) '(closure lambda))
;; See lambda_arity from eval.c
(when (eq (car func) 'closure)
(setq func (cdr func)))
(let ((syms-left (if (consp func)
(car func)
(signal 'invalid-function func)))
(min-args 0) (max-args 0) optional)
(catch 'many
(dolist (next syms-left)
(cond
((not (symbolp next))
(signal 'invalid-function func))
((eq next '&rest)
(throw 'many (cons min-args 'many)))
((eq next '&optional)
(setq optional t))
(t (unless optional
(setq min-args (1+ min-args)))
(setq max-args (1+ max-args)))))
(cons min-args max-args))))
((and (byte-code-function-p func) (numberp (aref func 0)))
;; See get_byte_code_arity from bytecode.c
(let ((at (aref func 0)))
(cons (logand at 127)
(if (= (logand at 128) 0)
(ash at -8)
'many))))
((and (byte-code-function-p func) (numberp (aref func 0)))
;; See get_byte_code_arity from bytecode.c
(let ((at (aref func 0)))
(cons (logand at 127)
(if (= (logand at 128) 0)
(ash at -8)
'many))))
((and (byte-code-function-p func) (listp (aref func 0)))
;; Based on `byte-compile-make-args-desc', this is required for
;; old versions of Emacs that don't use a integer for the argument
;; list description, per e2abe5a13dffb08d6371b6a611bc39c3a9ac2bc6.
(let ((arglist (aref func 0)) (mandatory 0) nonrest)
(while (and arglist (not (memq (car arglist) '(&optional &rest))))
(setq mandatory (1+ mandatory))
(setq arglist (cdr arglist)))
(setq nonrest mandatory)
(when (eq (car arglist) '&optional)
(setq arglist (cdr arglist))
(while (and arglist (not (eq (car arglist) '&rest)))
(setq nonrest (1+ nonrest))
(setq arglist (cdr arglist))))
(cons mandatory (if arglist 'many nonrest))))
((autoloadp func)
(autoload-do-load func)
(compat--func-arity func))
((signal 'invalid-function func))))
;;;; Defined in fns.c
(compat-defun assoc (key alist &optional testfn)
"Handle the optional argument TESTFN.
Equality is defined by the function TESTFN, defaulting to
‘equal’. TESTFN is called with 2 arguments: a car of an alist
element and KEY. With no optional argument, the function behaves
just like `assoc'."
:prefix t
(if testfn
(catch 'found
(dolist (ent alist)
(when (funcall testfn (car ent) key)
(throw 'found ent))))
(assoc key alist)))
(compat-defun mapcan (func sequence)
"Apply FUNC to each element of SEQUENCE.
Concatenate the results by altering them (using `nconc').
SEQUENCE may be a list, a vector, a boolean vector, or a string."
(apply #'nconc (mapcar func sequence)))
;;* UNTESTED
(compat-defun line-number-at-pos (&optional position absolute)
"Handle optional argument ABSOLUTE:
If the buffer is narrowed, the return value by default counts the lines
from the beginning of the accessible portion of the buffer. But if the
second optional argument ABSOLUTE is non-nil, the value counts the lines
from the absolute start of the buffer, disregarding the narrowing."
:prefix t
(if absolute
(save-restriction
(widen)
(line-number-at-pos position))
(line-number-at-pos position)))
;;;; Defined in subr.el
(declare-function compat--alist-get-full-elisp "compat-25"
(key alist &optional default remove testfn))
(compat-defun alist-get (key alist &optional default remove testfn)
"Handle TESTFN manually."
:realname compat--alist-get-handle-testfn
:prefix t
(if testfn
(compat--alist-get-full-elisp key alist default remove testfn)
(alist-get key alist default remove)))
(gv-define-expander compat-alist-get
(lambda (do key alist &optional default remove testfn)
(macroexp-let2 macroexp-copyable-p k key
(gv-letplace (getter setter) alist
(macroexp-let2 nil p `(if (and ,testfn (not (eq ,testfn 'eq)))
(compat-assoc ,k ,getter ,testfn)
(assq ,k ,getter))
(funcall do (if (null default) `(cdr ,p)
`(if ,p (cdr ,p) ,default))
(lambda (v)
(macroexp-let2 nil v v
(let ((set-exp
`(if ,p (setcdr ,p ,v)
,(funcall setter
`(cons (setq ,p (cons ,k ,v))
,getter)))))
`(progn
,(cond
((null remove) set-exp)
((or (eql v default)
(and (eq (car-safe v) 'quote)
(eq (car-safe default) 'quote)
(eql (cadr v) (cadr default))))
`(if ,p ,(funcall setter `(delq ,p ,getter))))
(t
`(cond
((not (eql ,default ,v)) ,set-exp)
(,p ,(funcall setter
`(delq ,p ,getter))))))
,v))))))))))
(compat-defun string-trim-left (string &optional regexp)
"Trim STRING of leading string matching REGEXP.
REGEXP defaults to \"[ \\t\\n\\r]+\"."
:realname compat--string-trim-left
:prefix t
(if (string-match (concat "\\`\\(?:" (or regexp "[ \t\n\r]+") "\\)") string)
(substring string (match-end 0))
string))
(compat-defun string-trim-right (string &optional regexp)
"Trim STRING of trailing string matching REGEXP.
REGEXP defaults to \"[ \\t\\n\\r]+\"."
:realname compat--string-trim-right
:prefix t
(let ((i (string-match-p
(concat "\\(?:" (or regexp "[ \t\n\r]+") "\\)\\'")
string)))
(if i (substring string 0 i) string)))
(compat-defun string-trim (string &optional trim-left trim-right)
"Trim STRING of leading with and trailing matching TRIM-LEFT and TRIM-RIGHT.
TRIM-LEFT and TRIM-RIGHT default to \"[ \\t\\n\\r]+\"."
:prefix t
;; `string-trim-left' and `string-trim-right' were moved from subr-x
;; to subr in Emacs 27, so to avoid loading subr-x we use the
;; compatibility function here:
(compat--string-trim-left
(compat--string-trim-right
string
trim-right)
trim-left))
(compat-defun caaar (x)
"Return the `car' of the `car' of the `car' of X."
(declare (pure t))
(car (car (car x))))
(compat-defun caadr (x)
"Return the `car' of the `car' of the `cdr' of X."
(declare (pure t))
(car (car (cdr x))))
(compat-defun cadar (x)
"Return the `car' of the `cdr' of the `car' of X."
(declare (pure t))
(car (cdr (car x))))
(compat-defun caddr (x)
"Return the `car' of the `cdr' of the `cdr' of X."
(declare (pure t))
(car (cdr (cdr x))))
(compat-defun cdaar (x)
"Return the `cdr' of the `car' of the `car' of X."
(declare (pure t))
(cdr (car (car x))))
(compat-defun cdadr (x)
"Return the `cdr' of the `car' of the `cdr' of X."
(declare (pure t))
(cdr (car (cdr x))))
(compat-defun cddar (x)
"Return the `cdr' of the `cdr' of the `car' of X."
(declare (pure t))
(cdr (cdr (car x))))
(compat-defun cdddr (x)
"Return the `cdr' of the `cdr' of the `cdr' of X."
(declare (pure t))
(cdr (cdr (cdr x))))
(compat-defun caaaar (x)
"Return the `car' of the `car' of the `car' of the `car' of X."
(declare (pure t))
(car (car (car (car x)))))
(compat-defun caaadr (x)
"Return the `car' of the `car' of the `car' of the `cdr' of X."
(declare (pure t))
(car (car (car (cdr x)))))
(compat-defun caadar (x)
"Return the `car' of the `car' of the `cdr' of the `car' of X."
(declare (pure t))
(car (car (cdr (car x)))))
(compat-defun caaddr (x)
"Return the `car' of the `car' of the `cdr' of the `cdr' of X."
(declare (pure t))
(car (car (cdr (cdr x)))))
(compat-defun cadaar (x)
"Return the `car' of the `cdr' of the `car' of the `car' of X."
(declare (pure t))
(car (cdr (car (car x)))))
(compat-defun cadadr (x)
"Return the `car' of the `cdr' of the `car' of the `cdr' of X."
(declare (pure t))
(car (cdr (car (cdr x)))))
(compat-defun caddar (x)
"Return the `car' of the `cdr' of the `cdr' of the `car' of X."
(declare (pure t))
(car (cdr (cdr (car x)))))
(compat-defun cadddr (x)
"Return the `car' of the `cdr' of the `cdr' of the `cdr' of X."
(declare (pure t))
(car (cdr (cdr (cdr x)))))
(compat-defun cdaaar (x)
"Return the `cdr' of the `car' of the `car' of the `car' of X."
(declare (pure t))
(cdr (car (car (car x)))))
(compat-defun cdaadr (x)
"Return the `cdr' of the `car' of the `car' of the `cdr' of X."
(declare (pure t))
(cdr (car (car (cdr x)))))
(compat-defun cdadar (x)
"Return the `cdr' of the `car' of the `cdr' of the `car' of X."
(declare (pure t))
(cdr (car (cdr (car x)))))
(compat-defun cdaddr (x)
"Return the `cdr' of the `car' of the `cdr' of the `cdr' of X."
(declare (pure t))
(cdr (car (cdr (cdr x)))))
(compat-defun cddaar (x)
"Return the `cdr' of the `cdr' of the `car' of the `car' of X."
(declare (pure t))
(cdr (cdr (car (car x)))))
(compat-defun cddadr (x)
"Return the `cdr' of the `cdr' of the `car' of the `cdr' of X."
(declare (pure t))
(cdr (cdr (car (cdr x)))))
(compat-defun cdddar (x)
"Return the `cdr' of the `cdr' of the `cdr' of the `car' of X."
(declare (pure t))
(cdr (cdr (cdr (car x)))))
(compat-defun cddddr (x)
"Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X."
(declare (pure t))
(cdr (cdr (cdr (cdr x)))))
(compat-defvar gensym-counter 0
"Number used to construct the name of the next symbol created by `gensym'.")
(compat-defun gensym (&optional prefix)
"Return a new uninterned symbol.
The name is made by appending `gensym-counter' to PREFIX.
PREFIX is a string, and defaults to \"g\"."
(let ((num (prog1 gensym-counter
(setq gensym-counter
(1+ gensym-counter)))))
(make-symbol (format "%s%d" (or prefix "g") num))))
;;;; Defined in files.el
(declare-function temporary-file-directory nil)
;;* UNTESTED
(compat-defun make-nearby-temp-file (prefix &optional dir-flag suffix)
"Create a temporary file as close as possible to `default-directory'.
If PREFIX is a relative file name, and `default-directory' is a
remote file name or located on a mounted file systems, the
temporary file is created in the directory returned by the
function `temporary-file-directory'. Otherwise, the function
`make-temp-file' is used. PREFIX, DIR-FLAG and SUFFIX have the
same meaning as in `make-temp-file'."
(let ((handler (find-file-name-handler
default-directory 'make-nearby-temp-file)))
(if (and handler (not (file-name-absolute-p default-directory)))
(funcall handler 'make-nearby-temp-file prefix dir-flag suffix)
(let ((temporary-file-directory (temporary-file-directory)))
(make-temp-file prefix dir-flag suffix)))))
(compat-defvar mounted-file-systems
(eval-when-compile
(if (memq system-type '(windows-nt cygwin))
"^//[^/]+/"
(concat
"^" (regexp-opt '("/afs/" "/media/" "/mnt" "/net/" "/tmp_mnt/")))))
"File systems that ought to be mounted.")
(compat-defun file-local-name (file)
"Return the local name component of FILE.
This function removes from FILE the specification of the remote host
and the method of accessing the host, leaving only the part that
identifies FILE locally on the remote system.
The returned file name can be used directly as argument of
`process-file', `start-file-process', or `shell-command'."
:realname compat--file-local-name
(or (file-remote-p file 'localname) file))
(compat-defun file-name-quoted-p (name &optional top)
"Whether NAME is quoted with prefix \"/:\".
If NAME is a remote file name and TOP is nil, check the local part of NAME."
:realname compat--file-name-quoted-p
(let ((file-name-handler-alist (unless top file-name-handler-alist)))
(string-prefix-p "/:" (compat--file-local-name name))))
(compat-defun file-name-quote (name &optional top)
"Add the quotation prefix \"/:\" to file NAME.
If NAME is a remote file name and TOP is nil, the local part of
NAME is quoted. If NAME is already a quoted file name, NAME is
returned unchanged."
(let ((file-name-handler-alist (unless top file-name-handler-alist)))
(if (compat--file-name-quoted-p name top)
name
(concat (file-remote-p name) "/:" (compat--file-local-name name)))))
;;* UNTESTED
(compat-defun temporary-file-directory ()
"The directory for writing temporary files.
In case of a remote `default-directory', this is a directory for
temporary files on that remote host. If such a directory does
not exist, or `default-directory' ought to be located on a
mounted file system (see `mounted-file-systems'), the function
returns `default-directory'.
For a non-remote and non-mounted `default-directory', the value of
the variable `temporary-file-directory' is returned."
(let ((handler (find-file-name-handler
default-directory 'temporary-file-directory)))
(if handler
(funcall handler 'temporary-file-directory)
(if (string-match mounted-file-systems default-directory)
default-directory
temporary-file-directory))))
;;* UNTESTED
(compat-defun file-attribute-type (attributes)
"The type field in ATTRIBUTES returned by `file-attributes'.
The value is either t for directory, string (name linked to) for
symbolic link, or nil."
(nth 0 attributes))
;;* UNTESTED
(compat-defun file-attribute-link-number (attributes)
"Return the number of links in ATTRIBUTES returned by `file-attributes'."
(nth 1 attributes))
;;* UNTESTED
(compat-defun file-attribute-user-id (attributes)
"The UID field in ATTRIBUTES returned by `file-attributes'.
This is either a string or a number. If a string value cannot be
looked up, a numeric value, either an integer or a float, is
returned."
(nth 2 attributes))
;;* UNTESTED
(compat-defun file-attribute-group-id (attributes)
"The GID field in ATTRIBUTES returned by `file-attributes'.
This is either a string or a number. If a string value cannot be
looked up, a numeric value, either an integer or a float, is
returned."
(nth 3 attributes))
;;* UNTESTED
(compat-defun file-attribute-access-time (attributes)
"The last access time in ATTRIBUTES returned by `file-attributes'.
This a Lisp timestamp in the style of `current-time'."
(nth 4 attributes))
;;* UNTESTED
(compat-defun file-attribute-modification-time (attributes)
"The modification time in ATTRIBUTES returned by `file-attributes'.
This is the time of the last change to the file's contents, and
is a Lisp timestamp in the style of `current-time'."
(nth 5 attributes))
;;* UNTESTED
(compat-defun file-attribute-status-change-time (attributes)
"The status modification time in ATTRIBUTES returned by `file-attributes'.
This is the time of last change to the file's attributes: owner
and group, access mode bits, etc., and is a Lisp timestamp in the
style of `current-time'."
(nth 6 attributes))
;;* UNTESTED
(compat-defun file-attribute-size (attributes)
"The integer size (in bytes) in ATTRIBUTES returned by `file-attributes'."
(nth 7 attributes))
;;* UNTESTED
(compat-defun file-attribute-modes (attributes)
"The file modes in ATTRIBUTES returned by `file-attributes'.
This is a string of ten letters or dashes as in ls -l."
(nth 8 attributes))
;;* UNTESTED
(compat-defun file-attribute-inode-number (attributes)
"The inode number in ATTRIBUTES returned by `file-attributes'.
It is a nonnegative integer."
(nth 10 attributes))
;;* UNTESTED
(compat-defun file-attribute-device-number (attributes)
"The file system device number in ATTRIBUTES returned by `file-attributes'.
It is an integer."
(nth 11 attributes))
(compat-defun file-attribute-collect (attributes &rest attr-names)
"Return a sublist of ATTRIBUTES returned by `file-attributes'.
ATTR-NAMES are symbols with the selected attribute names.
Valid attribute names are: type, link-number, user-id, group-id,
access-time, modification-time, status-change-time, size, modes,
inode-number and device-number."
(let ((idx '((type . 0)
(link-number . 1)
(user-id . 2)
(group-id . 3)
(access-time . 4)
(modification-time . 5)
(status-change-time . 6)
(size . 7)
(modes . 8)
(inode-number . 10)
(device-number . 11)))
result)
(while attr-names
(let ((attr (pop attr-names)))
(if (assq attr idx)
(push (nth (cdr (assq attr idx))
attributes)
result)
(error "Wrong attribute name '%S'" attr))))
(nreverse result)))
;;;; Defined in subr-x.el
(compat-defmacro if-let* (varlist then &rest else)
"Bind variables according to VARLIST and evaluate THEN or ELSE.
This is like `if-let' but doesn't handle a VARLIST of the form
\(SYMBOL SOMETHING) specially."
:realname compat--if-let*
:feature 'subr-x
(declare (indent 2)
(debug ((&rest [&or symbolp (symbolp form) (form)])
body)))
(let ((empty (make-symbol "s"))
(last t) list)
(dolist (var varlist)
(push `(,(if (cdr var) (car var) empty)
(and ,last ,(or (cadr var) (car var))))
list)
(when (or (cdr var) (consp (car var)))
(setq last (caar list))))
`(let* ,(nreverse list)
(if ,(caar list) ,then ,@else))))
(compat-defmacro when-let* (varlist &rest body)
"Bind variables according to VARLIST and conditionally evaluate BODY.
This is like `when-let' but doesn't handle a VARLIST of the form
\(SYMBOL SOMETHING) specially."
;; :feature 'subr-x
(declare (indent 1) (debug if-let*))
(let ((empty (make-symbol "s"))
(last t) list)
(dolist (var varlist)
(push `(,(if (cdr var) (car var) empty)
(and ,last ,(or (cadr var) (car var))))
list)
(when (or (cdr var) (consp (car var)))
(setq last (caar list))))
`(let* ,(nreverse list)
(when ,(caar list) ,@body))))
(compat-defmacro and-let* (varlist &rest body)
"Bind variables according to VARLIST and conditionally evaluate BODY.
Like `when-let*', except if BODY is empty and all the bindings
are non-nil, then the result is non-nil."
:feature 'subr-x
(declare (indent 1) (debug if-let*))
(let ((empty (make-symbol "s"))
(last t) list)
(dolist (var varlist)
(push `(,(if (cdr var) (car var) empty)
(and ,last ,(or (cadr var) (car var))))
list)
(when (or (cdr var) (consp (car var)))
(setq last (caar list))))
`(let* ,(nreverse list)
(if ,(caar list) ,(macroexp-progn (or body '(t)))))))
;;;; Defined in image.el
;;* UNTESTED
(compat-defun image-property (image property)
"Return the value of PROPERTY in IMAGE.
Properties can be set with
(setf (image-property IMAGE PROPERTY) VALUE)
If VALUE is nil, PROPERTY is removed from IMAGE."
(plist-get (cdr image) property))
;;* UNTESTED
(unless (get 'image-property 'gv-expander)
(gv-define-setter image-property (image property value)
(let ((image* (make-symbol "image"))
(property* (make-symbol "property"))
(value* (make-symbol "value")))
`(let ((,image* ,image)
(,property* ,property)
(,value* ,value))
(if
(null ,value*)
(while
(cdr ,image*)
(if
(eq
(cadr ,image*)
,property*)
(setcdr ,image*
(cdddr ,image*))
(setq ,image*
(cddr ,image*))))
(setcdr ,image*
(plist-put
(cdr ,image*)
,property* ,value*)))))))
(provide 'compat-26)
;;; compat-26.el ends here

642
org/elpa/compat-28.1.1.0/compat-27.el Normal file
View file

@ -0,0 +1,642 @@
;;; compat-27.el --- Compatibility Layer for Emacs 27.1 -*- lexical-binding: t; -*-
;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
;; Author: Philip Kaludercic <philipk@posteo.net>
;; Maintainer: Compat Development <~pkal/compat-devel@lists.sr.ht>
;; URL: https://git.sr.ht/~pkal/compat/
;; Keywords: lisp
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Find here the functionality added in Emacs 27.1, needed by older
;; versions.
;;
;; Do NOT load this library manually. Instead require `compat'.
;;; Code:
(eval-when-compile (require 'compat-macs))
;;;; Defined in fns.c
(compat-defun proper-list-p (object)
"Return OBJECT's length if it is a proper list, nil otherwise.
A proper list is neither circular nor dotted (i.e., its last cdr
is nil)."
:min-version "26.1"
:max-version "26.3"
:realname compat--proper-list-p-length-signal
(condition-case nil
(and (listp object) (length object))
(wrong-type-argument nil)
(circular-list nil)))
(compat-defun proper-list-p (object)
"Return OBJECT's length if it is a proper list, nil otherwise.
A proper list is neither circular nor dotted (i.e., its last cdr
is nil)."
:max-version "25.3"
:realname compat--proper-list-p-tortoise-hare
(when (listp object)
(catch 'cycle
(let ((hare object) (tortoise object)
(max 2) (q 2))
(while (consp hare)
(setq hare (cdr hare))
(when (and (or (/= 0 (setq q (1- q)))
(ignore
(setq max (ash max 1)
q max
tortoise hare)))
(eq hare tortoise))
(throw 'cycle nil)))
(and (null hare) (length object))))))
(compat-defun string-distance (string1 string2 &optional bytecompare)
"Return Levenshtein distance between STRING1 and STRING2.
The distance is the number of deletions, insertions, and substitutions
required to transform STRING1 into STRING2.
If BYTECOMPARE is nil or omitted, compute distance in terms of characters.
If BYTECOMPARE is non-nil, compute distance in terms of bytes.
Letter-case is significant, but text properties are ignored."
;; https://en.wikipedia.org/wiki/Levenshtein_distance
(let ((s1 (if bytecompare
(encode-coding-string string1 'raw-text)
(concat string1 "")))
(s2 (if bytecompare
(encode-coding-string string2 'raw-text)
string2)))
(let* ((len1 (length s1))
(len2 (length s2))
(column (make-vector (1+ len1) 0)))
(dotimes (y len1)
(setf (aref column (1+ y)) y))
(dotimes (x len2)
(setf (aref column 0) (1+ x))
(let ((lastdiag x) olddiag)
(dotimes (y len1)
(setf olddiag (aref column (1+ y))
(aref column (1+ y))
(min (+ (if (= (aref s1 y) (aref s2 x)) 0 1)
lastdiag)
(1+ (aref column (1+ y)))
(1+ (aref column y)))
lastdiag olddiag))))
(aref column len1))))
;;;; Defined in window.c
(compat-defun recenter (&optional arg redisplay)
"Handle optional argument REDISPLAY."
:prefix t
(recenter arg)
(when (and redisplay recenter-redisplay)
(redisplay)))
;;;; Defined in keymap.c
(compat-defun lookup-key (keymap key &optional accept-default)
"Allow for KEYMAP to be a list of keymaps."
:prefix t
(cond
((keymapp keymap)
(lookup-key keymap key accept-default))
((listp keymap)
(catch 'found
(dolist (map keymap)
(let ((fn (lookup-key map key accept-default)))
(when fn (throw 'found fn))))))
((signal 'wrong-type-argument (list 'keymapp keymap)))))
;;;; Defined in json.c
(declare-function json-parse-string nil (string &rest args))
(declare-function json-encode-string "json" (object))
(declare-function json-read-from-string "json" (string))
(declare-function json-read "json" ())
(defvar json-object-type)
(defvar json-array-type)
(defvar json-false)
(defvar json-null)
(compat-defun json-serialize (object &rest args)
"Return the JSON representation of OBJECT as a string.
OBJECT must be t, a number, string, vector, hashtable, alist, plist,
or the Lisp equivalents to the JSON null and false values, and its
elements must recursively consist of the same kinds of values. t will
be converted to the JSON true value. Vectors will be converted to
JSON arrays, whereas hashtables, alists and plists are converted to
JSON objects. Hashtable keys must be strings without embedded null
characters and must be unique within each object. Alist and plist
keys must be symbols; if a key is duplicate, the first instance is
used.
The Lisp equivalents to the JSON null and false values are
configurable in the arguments ARGS, a list of keyword/argument pairs:
The keyword argument `:null-object' specifies which object to use
to represent a JSON null value. It defaults to `:null'.
The keyword argument `:false-object' specifies which object to use to
represent a JSON false value. It defaults to `:false'.
In you specify the same value for `:null-object' and `:false-object',
a potentially ambiguous situation, the JSON output will not contain
any JSON false values."
:cond (condition-case nil
(let ((inhibit-message t))
(equal (json-parse-string "[]") nil))
(json-unavailable t)
(void-function t))
:realname compat--json-serialize
(require 'json)
(let ((json-false (or (plist-get args :false-object) :false))
(json-null (or (plist-get args :null-object) :null)))
(json-encode-string object)))
(compat-defun json-insert (object &rest args)
"Insert the JSON representation of OBJECT before point.
This is the same as (insert (json-serialize OBJECT)), but potentially
faster. See the function `json-serialize' for allowed values of
OBJECT."
:cond (condition-case nil
(let ((inhibit-message t))
(equal (json-parse-string "[]") nil))
(json-unavailable t)
(void-function t))
(insert (apply #'compat--json-serialize object args)))
(compat-defun json-parse-string (string &rest args)
"Parse the JSON STRING into a Lisp object.
This is essentially the reverse operation of `json-serialize', which
see. The returned object will be the JSON null value, the JSON false
value, t, a number, a string, a vector, a list, a hashtable, an alist,
or a plist. Its elements will be further objects of these types. If
there are duplicate keys in an object, all but the last one are
ignored. If STRING doesn't contain a valid JSON object, this function
signals an error of type `json-parse-error'.
The arguments ARGS are a list of keyword/argument pairs:
The keyword argument `:object-type' specifies which Lisp type is used
to represent objects; it can be `hash-table', `alist' or `plist'. It
defaults to `hash-table'.
The keyword argument `:array-type' specifies which Lisp type is used
to represent arrays; it can be `array' (the default) or `list'.
The keyword argument `:null-object' specifies which object to use
to represent a JSON null value. It defaults to `:null'.
The keyword argument `:false-object' specifies which object to use to
represent a JSON false value. It defaults to `:false'."
:cond (condition-case nil
(let ((inhibit-message t))
(equal (json-parse-string "[]") nil))
(json-unavailable t)
(void-function t))
(require 'json)
(condition-case err
(let ((json-object-type (or (plist-get args :object-type) 'hash-table))
(json-array-type (or (plist-get args :array-type) 'vector))
(json-false (or (plist-get args :false-object) :false))
(json-null (or (plist-get args :null-object) :null)))
(when (eq json-array-type 'array)
(setq json-array-type 'vector))
(json-read-from-string string))
(json-error (signal 'json-parse-error err))))
(compat-defun json-parse-buffer (&rest args)
"Read JSON object from current buffer starting at point.
Move point after the end of the object if parsing was successful.
On error, don't move point.
The returned object will be a vector, list, hashtable, alist, or
plist. Its elements will be the JSON null value, the JSON false
value, t, numbers, strings, or further vectors, lists, hashtables,
alists, or plists. If there are duplicate keys in an object, all
but the last one are ignored.
If the current buffer doesn't contain a valid JSON object, the
function signals an error of type `json-parse-error'.
The arguments ARGS are a list of keyword/argument pairs:
The keyword argument `:object-type' specifies which Lisp type is used
to represent objects; it can be `hash-table', `alist' or `plist'. It
defaults to `hash-table'.
The keyword argument `:array-type' specifies which Lisp type is used
to represent arrays; it can be `array' (the default) or `list'.
The keyword argument `:null-object' specifies which object to use
to represent a JSON null value. It defaults to `:null'.
The keyword argument `:false-object' specifies which object to use to
represent a JSON false value. It defaults to `:false'."
:cond (condition-case nil
(let ((inhibit-message t))
(equal (json-parse-string "[]") nil))
(json-unavailable t)
(void-function t))
(require 'json)
(condition-case err
(let ((json-object-type (or (plist-get args :object-type) 'hash-table))
(json-array-type (or (plist-get args :array-type) 'vector))
(json-false (or (plist-get args :false-object) :false))
(json-null (or (plist-get args :null-object) :null)))
(when (eq json-array-type 'array)
(setq json-array-type 'vector))
(json-read))
(json-error (signal 'json-parse-buffer err))))
;;;; Defined in timefns.c
(compat-defun time-equal-p (t1 t2)
"Return non-nil if time value T1 is equal to time value T2.
A nil value for either argument stands for the current time."
:note "This function is not as accurate as the actual `time-equal-p'."
(cond
((eq t1 t2))
((and (consp t1) (consp t2))
(equal t1 t2))
((let ((now (current-time)))
;; Due to inaccuracies and the relatively slow evaluating of
;; Emacs Lisp compared to C, we allow for slight inaccuracies
;; (less than a millisecond) when comparing time values.
(< (abs (- (float-time (or t1 now))
(float-time (or t2 now))))
1e-5)))))
;;;; Defined in subr.el
(compat-defmacro setq-local (&rest pairs)
"Handle multiple assignments."
:prefix t
(unless (zerop (mod (length pairs) 2))
(error "PAIRS must have an even number of variable/value members"))
(let (body)
(while pairs
(let* ((sym (pop pairs))
(val (pop pairs)))
(unless (symbolp sym)
(error "Attempting to set a non-symbol: %s" (car pairs)))
(push `(set (make-local-variable ,sym) ,val)
body)))
(cons 'progn (nreverse body))))
;;* UNTESTED
(compat-defmacro ignore-error (condition &rest body)
"Execute BODY; if the error CONDITION occurs, return nil.
Otherwise, return result of last form in BODY.
CONDITION can also be a list of error conditions."
(declare (debug t) (indent 1))
`(condition-case nil (progn ,@body) (,condition nil)))
;;* UNTESTED
(compat-defmacro dolist-with-progress-reporter (spec reporter-or-message &rest body)
"Loop over a list and report progress in the echo area.
Evaluate BODY with VAR bound to each car from LIST, in turn.
Then evaluate RESULT to get return value, default nil.
REPORTER-OR-MESSAGE is a progress reporter object or a string. In the latter
case, use this string to create a progress reporter.
At each iteration, print the reporter message followed by progress
percentage in the echo area. After the loop is finished,
print the reporter message followed by the word \"done\".
\(fn (VAR LIST [RESULT]) REPORTER-OR-MESSAGE BODY...)"
(declare (indent 2) (debug ((symbolp form &optional form) form body)))
(let ((prep (make-symbol "--dolist-progress-reporter--"))
(count (make-symbol "--dolist-count--"))
(list (make-symbol "--dolist-list--")))
`(let ((,prep ,reporter-or-message)
(,count 0)
(,list ,(cadr spec)))
(when (stringp ,prep)
(setq ,prep (make-progress-reporter ,prep 0 (1- (length ,list)))))
(dolist (,(car spec) ,list)
,@body
(progress-reporter-update ,prep (setq ,count (1+ ,count))))
(progress-reporter-done ,prep)
(or ,@(cdr (cdr spec)) nil))))
(compat-defun flatten-tree (tree)
"Return a \"flattened\" copy of TREE.
In other words, return a list of the non-nil terminal nodes, or
leaves, of the tree of cons cells rooted at TREE. Leaves in the
returned list are in the same order as in TREE.
\(flatten-tree \\='(1 (2 . 3) nil (4 5 (6)) 7))
=> (1 2 3 4 5 6 7)"
(let (elems)
(while (consp tree)
(let ((elem (pop tree)))
(while (consp elem)
(push (cdr elem) tree)
(setq elem (car elem)))
(if elem (push elem elems))))
(if tree (push tree elems))
(nreverse elems)))
(compat-defun xor (cond1 cond2)
"Return the boolean exclusive-or of COND1 and COND2.
If only one of the arguments is non-nil, return it; otherwise
return nil."
(declare (pure t) (side-effect-free error-free))
(cond ((not cond1) cond2)
((not cond2) cond1)))
(compat-defvar regexp-unmatchable "\\`a\\`"
"Standard regexp guaranteed not to match any string at all."
:constant t)
(compat-defun assoc-delete-all (key alist &optional test)
"Delete from ALIST all elements whose car is KEY.
Compare keys with TEST. Defaults to `equal'.
Return the modified alist.
Elements of ALIST that are not conses are ignored."
:prefix t
(unless test (setq test #'equal))
(while (and (consp (car alist))
(funcall test (caar alist) key))
(setq alist (cdr alist)))
(let ((tail alist) tail-cdr)
(while (setq tail-cdr (cdr tail))
(if (and (consp (car tail-cdr))
(funcall test (caar tail-cdr) key))
(setcdr tail (cdr tail-cdr))
(setq tail tail-cdr))))
alist)
;;;; Defined in simple.el
;;* UNTESTED
(compat-defun decoded-time-second (time)
"The seconds in TIME, which is a value returned by `decode-time'.
This is an integer between 0 and 60 (inclusive). (60 is a leap
second, which only some operating systems support.)"
(nth 0 time))
;;* UNTESTED
(compat-defun decoded-time-minute (time)
"The minutes in TIME, which is a value returned by `decode-time'.
This is an integer between 0 and 59 (inclusive)."
(nth 1 time))
;;* UNTESTED
(compat-defun decoded-time-hour (time)
"The hours in TIME, which is a value returned by `decode-time'.
This is an integer between 0 and 23 (inclusive)."
(nth 2 time))
;;* UNTESTED
(compat-defun decoded-time-day (time)
"The day-of-the-month in TIME, which is a value returned by `decode-time'.
This is an integer between 1 and 31 (inclusive)."
(nth 3 time))
;;* UNTESTED
(compat-defun decoded-time-month (time)
"The month in TIME, which is a value returned by `decode-time'.
This is an integer between 1 and 12 (inclusive). January is 1."
(nth 4 time))
;;* UNTESTED
(compat-defun decoded-time-year (time)
"The year in TIME, which is a value returned by `decode-time'.
This is a four digit integer."
(nth 5 time))
;;* UNTESTED
(compat-defun decoded-time-weekday (time)
"The day-of-the-week in TIME, which is a value returned by `decode-time'.
This is a number between 0 and 6, and 0 is Sunday."
(nth 6 time))
;;* UNTESTED
(compat-defun decoded-time-dst (time)
"The daylight saving time in TIME, which is a value returned by `decode-time'.
This is t if daylight saving time is in effect, and nil if not."
(nth 7 time))
;;* UNTESTED
(compat-defun decoded-time-zone (time)
"The time zone in TIME, which is a value returned by `decode-time'.
This is an integer indicating the UTC offset in seconds, i.e.,
the number of seconds east of Greenwich."
(nth 8 time))
;; TODO define gv-setters
;;;; Defined in files.el
(compat-defun file-size-human-readable (file-size &optional flavor space unit)
"Handle the optional third and forth argument:
Optional third argument SPACE is a string put between the number and unit.
It defaults to the empty string. We recommend a single space or
non-breaking space, unless other constraints prohibit a space in that
position.
Optional fourth argument UNIT is the unit to use. It defaults to \"B\"
when FLAVOR is `iec' and the empty string otherwise. We recommend \"B\"
in all cases, since that is the standard symbol for byte."
:prefix t
(let ((power (if (or (null flavor) (eq flavor 'iec))
1024.0
1000.0))
(prefixes '("" "k" "M" "G" "T" "P" "E" "Z" "Y")))
(while (and (>= file-size power) (cdr prefixes))
(setq file-size (/ file-size power)
prefixes (cdr prefixes)))
(let* ((prefix (car prefixes))
(prefixed-unit (if (eq flavor 'iec)
(concat
(if (string= prefix "k") "K" prefix)
(if (string= prefix "") "" "i")
(or unit "B"))
(concat prefix unit))))
(format (if (and (>= (mod file-size 1.0) 0.05)
(< (mod file-size 1.0) 0.95))
"%.1f%s%s"
"%.0f%s%s")
file-size
(if (string= prefixed-unit "") "" (or space ""))
prefixed-unit))))
(declare-function compat--file-name-quote "compat-26"
(name &optional top))
;;*UNTESTED
(compat-defun exec-path ()
"Return list of directories to search programs to run in remote subprocesses.
The remote host is identified by `default-directory'. For remote
hosts that do not support subprocesses, this returns nil.
If `default-directory' is a local directory, this function returns
the value of the variable `exec-path'."
:realname compat--exec-path
(cond
((let ((handler (find-file-name-handler default-directory 'exec-path)))
;; FIXME: The handler was added in 27.1, and this compatibility
;; function only applies to versions of Emacs before that.
(when handler
(condition-case nil
(funcall handler 'exec-path)
(error nil)))))
((file-remote-p default-directory)
;; TODO: This is not completely portable, even if "sh" and
;; "getconf" should be provided on every POSIX system, the chance
;; of this not working are greater than zero.
;;
;; FIXME: This invokes a shell process every time exec-path is
;; called. It should instead be cached on a host-local basis.
(with-temp-buffer
(if (condition-case nil
(zerop (process-file "sh" nil t nil "-c" "getconf PATH"))
(file-missing t))
(list "/bin" "/usr/bin")
(let (path)
(while (re-search-forward "\\([^:]+?\\)[\n:]" nil t)
(push (match-string 1) path))
(nreverse path)))))
(exec-path)))
(declare-function compat--file-local-name "compat-26"
(file))
;;*UNTESTED
(compat-defun executable-find (command &optional remote)
"Search for COMMAND in `exec-path' and return the absolute file name.
Return nil if COMMAND is not found anywhere in `exec-path'. If
REMOTE is non-nil, search on the remote host indicated by
`default-directory' instead."
:prefix t
(if (and remote (file-remote-p default-directory))
(let ((res (locate-file
command
(mapcar
(apply-partially
#'concat (file-remote-p default-directory))
(compat--exec-path))
exec-suffixes 'file-executable-p)))
(when (stringp res) (compat--file-local-name res)))
(executable-find command)))
;; TODO provide advice for directory-files-recursively
;;;; Defined in format-spec.el
;; TODO provide advice for format-spec
;;;; Defined in regexp-opt.el
(compat-defun regexp-opt (strings &optional paren)
"Handle an empty list of strings."
:prefix t
(if (null strings)
(let ((re "\\`a\\`"))
(cond ((null paren)
(concat "\\(?:" re "\\)"))
((stringp paren)
(concat paren re "\\)"))
((eq paren 'words)
(concat "\\<\\(" re "\\)\\>"))
((eq paren 'symbols)
(concat "\\_\\(<" re "\\)\\_>"))
((concat "\\(" re "\\)"))))
(regexp-opt strings paren)))
;;;; Defined in package.el
(declare-function lm-header "lisp-mnt")
;;* UNTESTED
(compat-defun package-get-version ()
"Return the version number of the package in which this is used.
Assumes it is used from an Elisp file placed inside the top-level directory
of an installed ELPA package.
The return value is a string (or nil in case we can’t find it)."
;; In a sense, this is a lie, but it does just what we want: precompute
;; the version at compile time and hardcodes it into the .elc file!
(declare (pure t))
;; Hack alert!
(let ((file
(or (and (boundp 'byte-compile-current-file) byte-compile-current-file)
load-file-name
buffer-file-name)))
(cond
((null file) nil)
;; Packages are normally installed into directories named "<pkg>-<vers>",
;; so get the version number from there.
((string-match
"/[^/]+-\\([0-9]\\(?:[0-9.]\\|pre\\|beta\\|alpha\\|snapshot\\)+\\)/[^/]+\\'"
file)
(match-string 1 file))
;; For packages run straight from the an elpa.git clone, there's no
;; "-<vers>" in the directory name, so we have to fetch the version
;; the hard way.
((let* ((pkgdir (file-name-directory file))
(pkgname (file-name-nondirectory (directory-file-name pkgdir)))
(mainfile (expand-file-name (concat pkgname ".el") pkgdir)))
(when (file-readable-p mainfile)
(require 'lisp-mnt)
(with-temp-buffer
(insert-file-contents mainfile)
(or (lm-header "package-version")
(lm-header "version")))))))))
;;;; Defined in dired.el
(declare-function
dired-get-marked-files "dired.el"
(&optional localp arg filter distinguish-one-marked error))
;;* UNTESTED
(compat-defun dired-get-marked-files
(&optional localp arg filter distinguish-one-marked error)
"Return the marked files’ names as list of strings."
:feature 'dired
:prefix t
(let ((result (dired-get-marked-files localp arg filter distinguish-one-marked)))
(if (and (null result) error)
(user-error (if (stringp error) error "No files specified"))
result)))
;;;; Defined in time-date.el
(compat-defun date-days-in-month (year month)
"The number of days in MONTH in YEAR."
:feature 'time-date
(unless (and (numberp month)
(<= 1 month)
(<= month 12))
(error "Month %s is invalid" month))
(if (= month 2)
(if (date-leap-year-p year)
29
28)
(if (memq month '(1 3 5 7 8 10 12))
31
30)))
(provide 'compat-27)
;;; compat-27.el ends here

835
org/elpa/compat-28.1.1.0/compat-28.el Normal file
View file

@ -0,0 +1,835 @@
;;; compat-28.el --- Compatibility Layer for Emacs 28.1 -*- lexical-binding: t; -*-
;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
;; Author: Philip Kaludercic <philipk@posteo.net>
;; Maintainer: Compat Development <~pkal/compat-devel@lists.sr.ht>
;; URL: https://git.sr.ht/~pkal/compat/
;; Keywords: lisp
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Find here the functionality added in Emacs 28.1, needed by older
;; versions.
;;
;; Do NOT load this library manually. Instead require `compat'.
;;; Code:
(eval-when-compile (require 'compat-macs))
;;;; Defined in fns.c
;;* INCOMPLETE FEATURE: Should handle multibyte regular expressions
(compat-defun string-search (needle haystack &optional start-pos)
"Search for the string NEEDLE in the strign HAYSTACK.
The return value is the position of the first occurrence of
NEEDLE in HAYSTACK, or nil if no match was found.
The optional START-POS argument says where to start searching in
HAYSTACK and defaults to zero (start at the beginning).
It must be between zero and the length of HAYSTACK, inclusive.
Case is always significant and text properties are ignored."
:note "Prior to Emacs 27 `string-match' has issues handling
multibyte regular expressions. As the compatibility function
for `string-search' is implemented via `string-match', these
issues are inherited."
(when (and start-pos (or (< (length haystack) start-pos)
(< start-pos 0)))
(signal 'args-out-of-range (list start-pos)))
(save-match-data
(let ((case-fold-search nil))
(string-match (regexp-quote needle) haystack start-pos))))
(compat-defun length= (sequence length)
"Returns non-nil if SEQUENCE has a length equal to LENGTH."
(cond
((null sequence) (zerop length))
((consp sequence)
(and (null (nthcdr length sequence))
(nthcdr (1- length) sequence)
t))
((arrayp sequence)
(= (length sequence) length))
((signal 'wrong-type-argument sequence))))
(compat-defun length< (sequence length)
"Returns non-nil if SEQUENCE is shorter than LENGTH."
(cond
((null sequence) (not (zerop length)))
((listp sequence)
(null (nthcdr (1- length) sequence)))
((arrayp sequence)
(< (length sequence) length))
((signal 'wrong-type-argument sequence))))
(compat-defun length> (sequence length)
"Returns non-nil if SEQUENCE is longer than LENGTH."
(cond
((listp sequence)
(and (nthcdr length sequence) t))
((arrayp sequence)
(> (length sequence) length))
((signal 'wrong-type-argument sequence))))
;;;; Defined in fileio.c
(compat-defun file-name-concat (directory &rest components)
"Append COMPONENTS to DIRECTORY and return the resulting string.
Elements in COMPONENTS must be a string or nil.
DIRECTORY or the non-final elements in COMPONENTS may or may not end
with a slash -- if they don’t end with a slash, a slash will be
inserted before contatenating."
(let ((seperator (eval-when-compile
(if (memq system-type '(ms-dos windows-nt cygwin))
"\\" "/")))
(last (if components (car (last components)) directory)))
(mapconcat (lambda (part)
(if (eq part last) ;the last component is not modified
last
(replace-regexp-in-string
(concat seperator "+\\'") "" part)))
(cons directory components)
seperator)))
;;;; Defined in alloc.c
;;* UNTESTED (but also not necessary)
(compat-defun garbage-collect-maybe (_factor)
"Call ‘garbage-collect’ if enough allocation happened.
FACTOR determines what \"enough\" means here: If FACTOR is a
positive number N, it means to run GC if more than 1/Nth of the
allocations needed to trigger automatic allocation took place.
Therefore, as N gets higher, this is more likely to perform a GC.
Returns non-nil if GC happened, and nil otherwise."
:note "For releases of Emacs before version 28, this function will do nothing."
;; Do nothing
nil)
;;;; Defined in filelock.c
(compat-defun unlock-buffer ()
"Handle `file-error' conditions:
Handles file system errors by calling ‘display-warning’ and
continuing as if the error did not occur."
:prefix t
(condition-case error
(unlock-buffer)
(file-error
(display-warning
'(unlock-file)
(message "%s, ignored" (error-message-string error))
:warning))))
;;;; Defined in characters.c
(compat-defun string-width (string &optional from to)
"Handle optional arguments FROM and TO:
Optional arguments FROM and TO specify the substring of STRING to
consider, and are interpreted as in `substring'."
:prefix t
(string-width (substring string (or from 0) to)))
;;;; Defined in dired.c
;;* UNTESTED
(compat-defun directory-files (directory &optional full match nosort count)
"Handle additional optional argument COUNT:
If COUNT is non-nil and a natural number, the function will
return COUNT number of file names (if so many are present)."
:prefix t
(let ((files (directory-files directory full match nosort)))
(when (natnump count)
(setf (nthcdr count files) nil))
files))
;;;; Defined in json.c
(declare-function json-insert nil (object &rest args))
(declare-function json-serialize nil (object &rest args))
(declare-function json-parse-string nil (string &rest args))
(declare-function json-parse-buffer nil (&rest args))
(compat-defun json-serialize (object &rest args)
"Handle top-level JSON values."
:prefix t
:min-version "27"
(if (or (listp object) (vectorp object))
(apply #'json-serialize object args)
(substring (json-serialize (list object)) 1 -1)))
(compat-defun json-insert (object &rest args)
"Handle top-level JSON values."
:prefix t
:min-version "27"
(if (or (listp object) (vectorp object))
(apply #'json-insert object args)
(insert (apply #'compat-json-serialize object args))))
(compat-defun json-parse-string (string &rest args)
"Handle top-level JSON values."
:prefix t
:min-version "27"
(if (string-match-p "\\`[[:space:]]*[[{]" string)
(apply #'json-parse-string string args)
;; Wrap the string in an array, and extract the value back using
;; `elt', to ensure that no matter what the value of `:array-type'
;; is we can access the first element.
(elt (apply #'json-parse-string (concat "[" string "]") args) 0)))
(compat-defun json-parse-buffer (&rest args)
"Handle top-level JSON values."
:prefix t
:min-version "27"
(if (looking-at-p "[[:space:]]*[[{]")
(apply #'json-parse-buffer args)
(catch 'escape
(atomic-change-group
(with-syntax-table
(let ((st (make-syntax-table)))
(modify-syntax-entry ?\" "\"" st)
(modify-syntax-entry ?. "_" st)
st)
(let ((inhibit-read-only t))
(save-excursion
(insert "[")
(forward-sexp 1)
(insert "]"))))
(throw 'escape (elt (apply #'json-parse-buffer args) 0))))))
;;;; xfaces.c
(compat-defun color-values-from-color-spec (spec)
"Parse color SPEC as a numeric color and return (RED GREEN BLUE).
This function recognises the following formats for SPEC:
#RGB, where R, G and B are hex numbers of equal length, 1-4 digits each.
rgb:R/G/B, where R, G, and B are hex numbers, 1-4 digits each.
rgbi:R/G/B, where R, G and B are floating-point numbers in [0,1].
If SPEC is not in one of the above forms, return nil.
Each of the 3 integer members of the resulting list, RED, GREEN,
and BLUE, is normalized to have its value in [0,65535]."
(let ((case-fold-search nil))
(save-match-data
(cond
((string-match
;; (rx bos "#"
;; (or (: (group-n 1 (= 1 hex)) (group-n 2 (= 1 hex)) (group-n 3 (= 1 hex)))
;; (: (group-n 1 (= 2 hex)) (group-n 2 (= 2 hex)) (group-n 3 (= 2 hex)))
;; (: (group-n 1 (= 3 hex)) (group-n 2 (= 3 hex)) (group-n 3 (= 3 hex)))
;; (: (group-n 1 (= 4 hex)) (group-n 2 (= 4 hex)) (group-n 3 (= 4 hex))))
;; eos)
"\\`#\\(?:\\(?1:[[:xdigit:]]\\{1\\}\\)\\(?2:[[:xdigit:]]\\{1\\}\\)\\(?3:[[:xdigit:]]\\{1\\}\\)\\|\\(?1:[[:xdigit:]]\\{2\\}\\)\\(?2:[[:xdigit:]]\\{2\\}\\)\\(?3:[[:xdigit:]]\\{2\\}\\)\\|\\(?1:[[:xdigit:]]\\{3\\}\\)\\(?2:[[:xdigit:]]\\{3\\}\\)\\(?3:[[:xdigit:]]\\{3\\}\\)\\|\\(?1:[[:xdigit:]]\\{4\\}\\)\\(?2:[[:xdigit:]]\\{4\\}\\)\\(?3:[[:xdigit:]]\\{4\\}\\)\\)\\'"
spec)
(let ((max (1- (ash 1 (* (- (match-end 1) (match-beginning 1)) 4)))))
(list (/ (* (string-to-number (match-string 1 spec) 16) 65535) max)
(/ (* (string-to-number (match-string 2 spec) 16) 65535) max)
(/ (* (string-to-number (match-string 3 spec) 16) 65535) max))))
((string-match
;; (rx bos "rgb:"
;; (group (** 1 4 hex)) "/"
;; (group (** 1 4 hex)) "/"
;; (group (** 1 4 hex))
;; eos)
"\\`rgb:\\([[:xdigit:]]\\{1,4\\}\\)/\\([[:xdigit:]]\\{1,4\\}\\)/\\([[:xdigit:]]\\{1,4\\}\\)\\'"
spec)
(list (/ (* (string-to-number (match-string 1 spec) 16) 65535)
(1- (ash 1 (* (- (match-end 1) (match-beginning 1)) 4))))
(/ (* (string-to-number (match-string 2 spec) 16) 65535)
(1- (ash 1 (* (- (match-end 2) (match-beginning 2)) 4))))
(/ (* (string-to-number (match-string 3 spec) 16) 65535)
(1- (ash 1 (* (- (match-end 3) (match-beginning 3)) 4))))))
;; The "RGBi" (RGB Intensity) specification is defined by
;; XCMS[0], see [1] for the implementation in Xlib.
;;
;; [0] http://www.nic.funet.fi/pub/X11/X11R4/DOCS/color/Xcms.text
;; [1] https://gitlab.freedesktop.org/xorg/lib/libx11/-/blob/master/src/xcms/LRGB.c#L1392
((string-match
(rx bos "rgbi:" (* space)
(group (? (or "-" "+"))
(or (: (+ digit) (? "." (* digit)))
(: "." (+ digit)))
(? "e" (? (or "-" "+")) (+ digit)))
"/" (* space)
(group (? (or "-" "+"))
(or (: (+ digit) (? "." (* digit)))
(: "." (+ digit)))
(? "e" (? (or "-" "+")) (+ digit)))
"/" (* space)
(group (? (or "-" "+"))
(or (: (+ digit) (? "." (* digit)))
(: "." (+ digit)))
(? "e" (? (or "-" "+")) (+ digit)))
eos)
spec)
(let ((r (round (* (string-to-number (match-string 1 spec)) 65535)))
(g (round (* (string-to-number (match-string 2 spec)) 65535)))
(b (round (* (string-to-number (match-string 3 spec)) 65535))))
(when (and (<= 0 r) (<= r 65535)
(<= 0 g) (<= g 65535)
(<= 0 b) (<= b 65535))
(list r g b))))))))
;;;; Defined in subr.el
;;* INCOMPLETE FEATURE: Should handle multibyte regular expressions
(compat-defun string-replace (fromstring tostring instring)
"Replace FROMSTRING with TOSTRING in INSTRING each time it occurs."
(when (equal fromstring "")
(signal 'wrong-length-argument '(0)))
(let ((case-fold-search nil))
(replace-regexp-in-string
(regexp-quote fromstring)
tostring instring
t t)))
(compat-defun always (&rest _arguments)
"Do nothing and return t.
This function accepts any number of ARGUMENTS, but ignores them.
Also see `ignore'."
t)
;;* UNTESTED
(compat-defun insert-into-buffer (buffer &optional start end)
"Insert the contents of the current buffer into BUFFER.
If START/END, only insert that region from the current buffer.
Point in BUFFER will be placed after the inserted text."
(let ((current (current-buffer)))
(with-current-buffer buffer
(insert-buffer-substring current start end))))
;;* UNTESTED
(compat-defun replace-string-in-region (string replacement &optional start end)
"Replace STRING with REPLACEMENT in the region from START to END.
The number of replaced occurrences are returned, or nil if STRING
doesn't exist in the region.
If START is nil, use the current point. If END is nil, use `point-max'.
Comparisons and replacements are done with fixed case."
(if start
(when (< start (point-min))
(error "Start before start of buffer"))
(setq start (point)))
(if end
(when (> end (point-max))
(error "End after end of buffer"))
(setq end (point-max)))
(save-excursion
(let ((matches 0)
(case-fold-search nil))
(goto-char start)
(while (search-forward string end t)
(delete-region (match-beginning 0) (match-end 0))
(insert replacement)
(setq matches (1+ matches)))
(and (not (zerop matches))
matches))))
;;* UNTESTED
(compat-defun replace-regexp-in-region (regexp replacement &optional start end)
"Replace REGEXP with REPLACEMENT in the region from START to END.
The number of replaced occurrences are returned, or nil if REGEXP
doesn't exist in the region.
If START is nil, use the current point. If END is nil, use `point-max'.
Comparisons and replacements are done with fixed case.
REPLACEMENT can use the following special elements:
`\\&' in NEWTEXT means substitute original matched text.
`\\N' means substitute what matched the Nth `\\(...\\)'.
If Nth parens didn't match, substitute nothing.
`\\\\' means insert one `\\'.
`\\?' is treated literally."
(if start
(when (< start (point-min))
(error "Start before start of buffer"))
(setq start (point)))
(if end
(when (> end (point-max))
(error "End after end of buffer"))
(setq end (point-max)))
(save-excursion
(let ((matches 0)
(case-fold-search nil))
(goto-char start)
(while (re-search-forward regexp end t)
(replace-match replacement t)
(setq matches (1+ matches)))
(and (not (zerop matches))
matches))))
;;* UNTESTED
(compat-defun buffer-local-boundp (symbol buffer)
"Return non-nil if SYMBOL is bound in BUFFER.
Also see `local-variable-p'."
(catch 'fail
(condition-case nil
(buffer-local-value symbol buffer)
(void-variable nil (throw 'fail nil)))
t))
;;* UNTESTED
(compat-defmacro with-existing-directory (&rest body)
"Execute BODY with `default-directory' bound to an existing directory.
If `default-directory' is already an existing directory, it's not changed."
(declare (indent 0) (debug t))
(let ((quit (make-symbol "with-existing-directory-quit")))
`(catch ',quit
(dolist (dir (list default-directory
(expand-file-name "~/")
(getenv "TMPDIR")
"/tmp/"
;; XXX: check if "/" works on non-POSIX
;; system.
"/"))
(when (and dir (file-exists-p dir))
(throw ',quit (let ((default-directory dir))
,@body)))))))
;;* UNTESTED
(compat-defmacro dlet (binders &rest body)
"Like `let' but using dynamic scoping."
(declare (indent 1) (debug let))
`(let (_)
,@(mapcar (lambda (binder)
`(defvar ,(if (consp binder) (car binder) binder)))
binders)
(let ,binders ,@body)))
(compat-defun ensure-list (object)
"Return OBJECT as a list.
If OBJECT is already a list, return OBJECT itself. If it's
not a list, return a one-element list containing OBJECT."
(if (listp object)
object
(list object)))
;;;; Defined in subr-x.el
(compat-defun string-clean-whitespace (string)
"Clean up whitespace in STRING.
All sequences of whitespaces in STRING are collapsed into a
single space character, and leading/trailing whitespace is
removed."
:feature 'subr-x
(let ((blank "[[:blank:]\r\n]+"))
(replace-regexp-in-string
"^[[:blank:]\r\n]+\\|[[:blank:]\r\n]+$"
""
(replace-regexp-in-string
blank " " string))))
(compat-defun string-fill (string length)
"Clean up whitespace in STRING.
All sequences of whitespaces in STRING are collapsed into a
single space character, and leading/trailing whitespace is
removed."
:feature 'subr-x
(with-temp-buffer
(insert string)
(goto-char (point-min))
(let ((fill-column length)
(adaptive-fill-mode nil))
(fill-region (point-min) (point-max)))
(buffer-string)))
(compat-defun string-lines (string &optional omit-nulls)
"Split STRING into a list of lines.
If OMIT-NULLS, empty lines will be removed from the results."
:feature 'subr-x
(split-string string "\n" omit-nulls))
(compat-defun string-pad (string length &optional padding start)
"Pad STRING to LENGTH using PADDING.
If PADDING is nil, the space character is used. If not nil, it
should be a character.
If STRING is longer than the absolute value of LENGTH, no padding
is done.
If START is nil (or not present), the padding is done to the end
of the string, and if non-nil, padding is done to the start of
the string."
:feature 'subr-x
(unless (natnump length)
(signal 'wrong-type-argument (list 'natnump length)))
(let ((pad-length (- length (length string))))
(if (< pad-length 0)
string
(concat (and start
(make-string pad-length (or padding ?\s)))
string
(and (not start)
(make-string pad-length (or padding ?\s)))))))
(compat-defun string-chop-newline (string)
"Remove the final newline (if any) from STRING."
:feature 'subr-x
(if (and (>= (length string) 1) (= (aref string (1- (length string))) ?\n))
(substring string 0 -1)
string))
(compat-defmacro named-let (name bindings &rest body)
"Looping construct taken from Scheme.
Like `let', bind variables in BINDINGS and then evaluate BODY,
but with the twist that BODY can evaluate itself recursively by
calling NAME, where the arguments passed to NAME are used
as the new values of the bound variables in the recursive invocation."
:feature 'subr-x
(declare (indent 2) (debug (symbolp (&rest (symbolp form)) body)))
(let ((fargs (mapcar (lambda (b)
(let ((var (if (consp b) (car b) b)))
(make-symbol (symbol-name var))))
bindings))
(aargs (mapcar (lambda (b) (if (consp b) (cadr b))) bindings))
rargs)
(dotimes (i (length bindings))
(let ((b (nth i bindings)))
(push (list (if (consp b) (car b) b) (nth i fargs))
rargs)
(setf (if (consp b) (car b) b)
(nth i fargs))))
(letrec
((quit (make-symbol "quit")) (self (make-symbol "self"))
(total-tco t)
(macro (lambda (&rest args)
(setq total-tco nil)
`(funcall ,self . ,args)))
;; Based on `cl--self-tco':
(tco-progn (lambda (exprs)
(append
(butlast exprs)
(list (funcall tco (car (last exprs)))))))
(tco (lambda (expr)
(cond
((eq (car-safe expr) 'if)
(append (list 'if
(cadr expr)
(funcall tco (nth 2 expr)))
(funcall tco-progn (nthcdr 3 expr))))
((eq (car-safe expr) 'cond)
(let ((conds (cdr expr)) body)
(while conds
(let ((branch (pop conds)))
(push (cond
((cdr branch) ;has tail
(funcall tco-progn branch))
((null conds) ;last element
(list t (funcall tco (car branch))))
((progn
branch)))
body)))
(cons 'cond (nreverse body))))
((eq (car-safe expr) 'or)
(if (cddr expr)
(let ((var (make-symbol "var")))
`(let ((,var ,(cadr expr)))
(if ,var ,(funcall tco var)
,(funcall tco (cons 'or (cddr expr))))))
(funcall tco (cadr expr))))
((eq (car-safe expr) 'condition-case)
(append (list 'condition-case (cadr expr) (nth 2 expr))
(mapcar
(lambda (handler)
(cons (car handler)
(funcall tco-progn (cdr handler))))
(nthcdr 3 expr))))
((memq (car-safe expr) '(and progn))
(cons (car expr) (funcall tco-progn (cdr expr))))
((memq (car-safe expr) '(let let*))
(append (list (car expr) (cadr expr))
(funcall tco-progn (cddr expr))))
((eq (car-safe expr) name)
(let (sets (args (cdr expr)))
(dolist (farg fargs)
(push (list farg (pop args))
sets))
(cons 'setq (apply #'nconc (nreverse sets)))))
(`(throw ',quit ,expr))))))
(let ((tco-body (funcall tco (macroexpand-all (macroexp-progn body)))))
(when tco-body
(setq body `((catch ',quit
(while t (let ,rargs ,@(macroexp-unprogn tco-body))))))))
(let ((expand (macroexpand-all (macroexp-progn body) (list (cons name macro)))))
(if total-tco
`(let ,bindings ,expand)
`(funcall
(letrec ((,self (lambda ,fargs ,expand))) ,self)
,@aargs))))))
;;;; Defined in files.el
(declare-function compat--string-trim-left "compat-26" (string &optional regexp))
(declare-function compat--directory-name-p "compat-25" (name))
(compat-defun file-name-with-extension (filename extension)
"Set the EXTENSION of a FILENAME.
The extension (in a file name) is the part that begins with the last \".\".
Trims a leading dot from the EXTENSION so that either \"foo\" or
\".foo\" can be given.
Errors if the FILENAME or EXTENSION are empty, or if the given
FILENAME has the format of a directory.
See also `file-name-sans-extension'."
(let ((extn (compat--string-trim-left extension "[.]")))
(cond
((string= filename "")
(error "Empty filename"))
((string= extn "")
(error "Malformed extension: %s" extension))
((compat--directory-name-p filename)
(error "Filename is a directory: %s" filename))
(t
(concat (file-name-sans-extension filename) "." extn)))))
;;* UNTESTED
(compat-defun directory-empty-p (dir)
"Return t if DIR names an existing directory containing no other files.
Return nil if DIR does not name a directory, or if there was
trouble determining whether DIR is a directory or empty.
Symbolic links to directories count as directories.
See `file-symlink-p' to distinguish symlinks."
(and (file-directory-p dir)
(null (directory-files dir nil directory-files-no-dot-files-regexp t))))
(compat-defun file-modes-number-to-symbolic (mode &optional filetype)
"Return a string describing a file's MODE.
For instance, if MODE is #o700, then it produces `-rwx------'.
FILETYPE if provided should be a character denoting the type of file,
such as `?d' for a directory, or `?l' for a symbolic link and will override
the leading `-' char."
(string
(or filetype
(pcase (lsh mode -12)
;; POSIX specifies that the file type is included in st_mode
;; and provides names for the file types but values only for
;; the permissions (e.g., S_IWOTH=2).
;; (#o017 ??) ;; #define S_IFMT 00170000
(#o014 ?s) ;; #define S_IFSOCK 0140000
(#o012 ?l) ;; #define S_IFLNK 0120000
;; (8 ??) ;; #define S_IFREG 0100000
(#o006 ?b) ;; #define S_IFBLK 0060000
(#o004 ?d) ;; #define S_IFDIR 0040000
(#o002 ?c) ;; #define S_IFCHR 0020000
(#o001 ?p) ;; #define S_IFIFO 0010000
(_ ?-)))
(if (zerop (logand 256 mode)) ?- ?r)
(if (zerop (logand 128 mode)) ?- ?w)
(if (zerop (logand 64 mode))
(if (zerop (logand 2048 mode)) ?- ?S)
(if (zerop (logand 2048 mode)) ?x ?s))
(if (zerop (logand 32 mode)) ?- ?r)
(if (zerop (logand 16 mode)) ?- ?w)
(if (zerop (logand 8 mode))
(if (zerop (logand 1024 mode)) ?- ?S)
(if (zerop (logand 1024 mode)) ?x ?s))
(if (zerop (logand 4 mode)) ?- ?r)
(if (zerop (logand 2 mode)) ?- ?w)
(if (zerop (logand 512 mode))
(if (zerop (logand 1 mode)) ?- ?x)
(if (zerop (logand 1 mode)) ?T ?t))))
;;* UNTESTED
(compat-defun file-backup-file-names (filename)
"Return a list of backup files for FILENAME.
The list will be sorted by modification time so that the most
recent files are first."
;; `make-backup-file-name' will get us the right directory for
;; ordinary or numeric backups. It might create a directory for
;; backups as a side-effect, according to `backup-directory-alist'.
(let* ((filename (file-name-sans-versions
(make-backup-file-name (expand-file-name filename))))
(dir (file-name-directory filename))
files)
(dolist (file (file-name-all-completions
(file-name-nondirectory filename) dir))
(let ((candidate (concat dir file)))
(when (and (backup-file-name-p candidate)
(string= (file-name-sans-versions candidate) filename))
(push candidate files))))
(sort files #'file-newer-than-file-p)))
(compat-defun make-lock-file-name (filename)
"Make a lock file name for FILENAME.
This prepends \".#\" to the non-directory part of FILENAME, and
doesn't respect `lock-file-name-transforms', as Emacs 28.1 and
onwards does."
(expand-file-name
(concat
".#" (file-name-nondirectory filename))
(file-name-directory filename)))
;;;; Defined in files-x.el
(declare-function tramp-tramp-file-p "tramp" (name))
;;* UNTESTED
(compat-defun null-device ()
"Return the best guess for the null device."
(require 'tramp)
(if (tramp-tramp-file-p default-directory)
"/dev/null"
null-device))
;;;; Defined in minibuffer.el
(compat-defun format-prompt (prompt default &rest format-args)
"Format PROMPT with DEFAULT.
If FORMAT-ARGS is nil, PROMPT is used as a plain string. If
FORMAT-ARGS is non-nil, PROMPT is used as a format control
string, and FORMAT-ARGS are the arguments to be substituted into
it. See `format' for details.
If DEFAULT is a list, the first element is used as the default.
If not, the element is used as is.
If DEFAULT is nil or an empty string, no \"default value\" string
is included in the return value."
(concat
(if (null format-args)
prompt
(apply #'format prompt format-args))
(and default
(or (not (stringp default))
(not (null default)))
(format " (default %s)"
(if (consp default)
(car default)
default)))
": "))
;;;; Defined in windows.el
;;* UNTESTED
(compat-defun count-windows (&optional minibuf all-frames)
"Handle optional argument ALL-FRAMES:
If ALL-FRAMES is non-nil, count the windows in all frames instead
just the selected frame."
:prefix t
(if all-frames
(let ((sum 0))
(dolist (frame (frame-list))
(with-selected-frame frame
(setq sum (+ (count-windows minibuf) sum))))
sum)
(count-windows minibuf)))
;;;; Defined in thingatpt.el
(declare-function mouse-set-point "mouse" (event &optional promote-to-region))
;;* UNTESTED
(compat-defun thing-at-mouse (event thing &optional no-properties)
"Return the THING at mouse click.
Like `thing-at-point', but tries to use the event
where the mouse button is clicked to find a thing nearby."
:feature 'thingatpt
(save-excursion
(mouse-set-point event)
(thing-at-point thing no-properties)))
;;;; Defined in macroexp.el
;;* UNTESTED
(compat-defun macroexp-file-name ()
"Return the name of the file from which the code comes.
Returns nil when we do not know.
A non-nil result is expected to be reliable when called from a macro in order
to find the file in which the macro's call was found, and it should be
reliable as well when used at the top-level of a file.
Other uses risk returning non-nil value that point to the wrong file."
:feature 'macroexp
(let ((file (car (last current-load-list))))
(or (if (stringp file) file)
(bound-and-true-p byte-compile-current-file))))
;;;; Defined in env.el
;;* UNTESTED
(compat-defmacro with-environment-variables (variables &rest body)
"Set VARIABLES in the environent and execute BODY.
VARIABLES is a list of variable settings of the form (VAR VALUE),
where VAR is the name of the variable (a string) and VALUE
is its value (also a string).
The previous values will be be restored upon exit."
(declare (indent 1) (debug (sexp body)))
(unless (consp variables)
(error "Invalid VARIABLES: %s" variables))
`(let ((process-environment (copy-sequence process-environment)))
,@(mapcar (lambda (elem)
`(setenv ,(car elem) ,(cadr elem)))
variables)
,@body))
;;;; Defined in button.el
;;* UNTESTED
(compat-defun button-buttonize (string callback &optional data)
"Make STRING into a button and return it.
When clicked, CALLBACK will be called with the DATA as the
function argument. If DATA isn't present (or is nil), the button
itself will be used instead as the function argument."
:feature 'button
(propertize string
'face 'button
'button t
'follow-link t
'category t
'button-data data
'keymap button-map
'action callback))
;;;; Defined in autoload.el
(defvar generated-autoload-file)
;;* UNTESTED
(compat-defun make-directory-autoloads (dir output-file)
"Update autoload definitions for Lisp files in the directories DIRS.
DIR can be either a single directory or a list of
directories. (The latter usage is discouraged.)
The autoloads will be written to OUTPUT-FILE. If any Lisp file
binds `generated-autoload-file' as a file-local variable, write
its autoloads into the specified file instead.
The function does NOT recursively descend into subdirectories of the
directory or directories specified."
(let ((generated-autoload-file output-file))
;; We intentionally don't sharp-quote
;; `update-directory-autoloads', because it was deprecated in
;; Emacs 28 and we don't want to trigger the byte compiler for
;; newer versions.
(apply 'update-directory-autoloads
(if (listp dir) dir (list dir)))))
(provide 'compat-28)
;;; compat-28.el ends here

35
org/elpa/compat-28.1.1.0/compat-autoloads.el Normal file
View file

@ -0,0 +1,35 @@
;;; compat-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*-
;;
;;; Code:
(add-to-list 'load-path (directory-file-name
(or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil "compat-help" "compat-help.el" (0 0 0 0))
;;; Generated autoloads from compat-help.el
(register-definition-prefixes "compat-help" '("compat---describe"))
;;;***
;;;### (autoloads nil "compat-macs" "compat-macs.el" (0 0 0 0))
;;; Generated autoloads from compat-macs.el
(register-definition-prefixes "compat-macs" '("compat-"))
;;;***
;;;### (autoloads nil nil ("compat-24.el" "compat-25.el" "compat-26.el"
;;;;;; "compat-27.el" "compat-28.el" "compat-font-lock.el" "compat-pkg.el"
;;;;;; "compat.el") (0 0 0 0))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; compat-autoloads.el ends here

48
org/elpa/compat-28.1.1.0/compat-font-lock.el Normal file
View file

@ -0,0 +1,48 @@
;;; compat-font-lock.el --- -*- lexical-binding: t; -*-
;; Copyright (C) 2022 Free Software Foundation, Inc.
;; Author: Philip Kaludercic <philipk@posteo.net>
;; Keywords:
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Optional font-locking for `compat' definitions. Every symbol with
;; an active compatibility definition will be highlighted.
;;
;; Load this file to enable the functionality.
;;; Code:
(eval-and-compile
(require 'cl-lib)
(require 'compat-macs))
(defvar compat-generate-common-fn)
(let ((compat-generate-common-fn
(lambda (name _def-fn _install-fn check-fn attr _type)
(unless (and (plist-get attr :no-highlight)
(funcall check-fn))
`(font-lock-add-keywords
'emacs-lisp-mode
',`((,(concat "\\_<\\("
(regexp-quote (symbol-name name))
"\\)\\_>")
1 font-lock-preprocessor-face prepend)))))))
(load "compat"))
(provide 'compat-font-lock)
;;; compat-font-lock.el ends here

57
org/elpa/compat-28.1.1.0/compat-help.el Normal file
View file

@ -0,0 +1,57 @@
;;; compat-help.el --- Documentation for compat functions -*- lexical-binding: t; -*-
;; Copyright (C) 2022 Free Software Foundation, Inc.
;; Author: Philip Kaludercic <philipk@posteo.net>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Load this file to insert `compat'-relevant documentation next to
;; the regular documentation of a symbol.
;;; Code:
(defun compat---describe (symbol)
"Insert documentation for SYMBOL if it has compatibility code."
(let ((compat (get symbol 'compat-def)))
(when compat
(let ((doc (get compat 'compat-doc))
(start (point)))
(when doc
(insert "There is a ")
(insert-button
"compatibility notice"
'action (let ((type (get compat 'compat-type)))
(cond
((memq type '(func macro advice))
#'find-function)
((memq type '(variable))
#'find-variable)
((error "Unknown type"))))
'button-data compat)
(insert (format " for %s (for versions of Emacs before %s):"
(symbol-name symbol)
(get compat 'compat-version)))
(add-text-properties start (point) '(face bold))
(newline 2)
(insert (substitute-command-keys doc))
(fill-region start (point))
(newline 2))))))
(add-hook 'help-fns-describe-function-functions #'compat---describe)
(provide 'compat-help)
;;; compat-help.el ends here

367
org/elpa/compat-28.1.1.0/compat-macs.el Normal file
View file

@ -0,0 +1,367 @@
;;; compat-macs.el --- Compatibility Macros -*- lexical-binding: t; -*-
;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
;; Author: Philip Kaludercic <philipk@posteo.net>
;; Keywords: lisp
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; These macros are used to define compatibility functions, macros and
;; advice.
;;; Code:
(defmacro compat--ignore (&rest _)
"Ignore all arguments."
nil)
(defvar compat--generate-function #'compat--generate-minimal
"Function used to generate compatibility code.
The function must take six arguments: NAME, DEF-FN, INSTALL-FN,
CHECK-FN, ATTR and TYPE. The resulting body is constructed by
invoking the functions DEF-FN (passed the \"realname\" and the
version number, returning the compatibility definition), the
INSTALL-FN (passed the \"realname\" and returning the
installation code), CHECK-FN (passed the \"realname\" and
returning a check to see if the compatibility definition should
be installed). ATTR is a plist used to modify the generated
code. The following attributes are handled, all others are
ignored:
- :min-version :: Prevent the compatibility definition from begin
installed in versions older than indicated (string).
- :max-version :: Prevent the compatibility definition from begin
installed in versions newer than indicated (string).
- :feature :: The library the code is supposed to be loaded
with (via `eval-after-load').
- :cond :: Only install the compatibility code, iff the value
evaluates to non-nil.
For prefixed functions, this can be interpreted as a test to
`defalias' an existing definition or not.
- :no-highlight :: Do not highlight this definition as
compatibility function.
- :version :: Manual specification of the version the compatee
code was defined in (string).
- :realname :: Manual specification of a \"realname\" to use for
the compatibility definition (symbol).
- :notes :: Additional notes that a developer using this
compatibility function should keep in mind.
- :prefix :: Add a `compat-' prefix to the name, and define the
compatibility code unconditionally.
TYPE is used to set the symbol property `compat-type' for NAME.")
(defun compat--generate-minimal (name def-fn install-fn check-fn attr type)
"Generate a leaner compatibility definition.
See `compat-generate-function' for details on the arguments NAME,
DEF-FN, INSTALL-FN, CHECK-FN, ATTR and TYPE."
(let* ((min-version (plist-get attr :min-version))
(max-version (plist-get attr :max-version))
(feature (plist-get attr :feature))
(cond (plist-get attr :cond))
(version (or (plist-get attr :version)
(let ((file (or (bound-and-true-p byte-compile-current-file)
load-file-name
(buffer-file-name))))
;; Guess the version from the file the macro is
;; being defined in.
(cond
((not file) emacs-version)
((string-match
"compat-\\([[:digit:]]+\\)\\.\\(?:elc?\\)\\'"
file)
(match-string 1 file))
((error "No version number could be extracted"))))))
(realname (or (plist-get attr :realname)
(intern (format "compat--%S" name))))
(check (cond
((or (and min-version
(version< emacs-version min-version))
(and max-version
(version< max-version emacs-version)))
'(compat--ignore))
((plist-get attr :prefix)
'(progn))
((and version (version<= version emacs-version) (not cond))
'(compat--ignore))
(`(when (and ,(if cond cond t)
,(funcall check-fn)))))))
(cond
((and (plist-get attr :prefix) (memq type '(func macro))
(string-match "\\`compat-\\(.+\\)\\'" (symbol-name name))
(let* ((actual-name (intern (match-string 1 (symbol-name name))))
(body (funcall install-fn actual-name version)))
(when (and (version<= version emacs-version)
(fboundp actual-name))
`(,@check
,(if feature
;; See https://nullprogram.com/blog/2018/02/22/:
`(eval-after-load ,feature `(funcall ',(lambda () ,body)))
body))))))
((plist-get attr :realname)
`(progn
,(funcall def-fn realname version)
(,@check
,(let ((body (funcall install-fn realname version)))
(if feature
;; See https://nullprogram.com/blog/2018/02/22/:
`(eval-after-load ,feature `(funcall ',(lambda () ,body)))
body)))))
((let* ((body (if (eq type 'advice)
`(,@check
,(funcall def-fn realname version)
,(funcall install-fn realname version))
`(,@check ,(funcall def-fn name version)))))
(if feature
;; See https://nullprogram.com/blog/2018/02/22/:
`(eval-after-load ,feature `(funcall ',(lambda () ,body)))
body))))))
(defun compat--generate-minimal-no-prefix (name def-fn install-fn check-fn attr type)
"Generate a leaner compatibility definition.
See `compat-generate-function' for details on the arguments NAME,
DEF-FN, INSTALL-FN, CHECK-FN, ATTR and TYPE."
(unless (plist-get attr :prefix)
(compat--generate-minimal name def-fn install-fn check-fn attr type)))
(defun compat--generate-verbose (name def-fn install-fn check-fn attr type)
"Generate a more verbose compatibility definition, fit for testing.
See `compat-generate-function' for details on the arguments NAME,
DEF-FN, INSTALL-FN, CHECK-FN, ATTR and TYPE."
(let* ((min-version (plist-get attr :min-version))
(max-version (plist-get attr :max-version))
(feature (plist-get attr :feature))
(cond (plist-get attr :cond))
(version (or (plist-get attr :version)
(let ((file (or (bound-and-true-p byte-compile-current-file)
load-file-name
(buffer-file-name))))
;; Guess the version from the file the macro is
;; being defined in.
(cond
((not file) emacs-version)
((string-match
"compat-\\([[:digit:]]+\\)\\.\\(?:elc?\\)\\'"
file)
(match-string 1 file))
((error "No version number could be extracted"))))))
(realname (or (plist-get attr :realname)
(intern (format "compat--%S" name))))
(body `(progn
(unless (or (null (get ',name 'compat-def))
(eq (get ',name 'compat-def) ',realname))
(error "Duplicate compatibility definition: %s (was %s, now %s)"
',name (get ',name 'compat-def) ',realname))
(put ',name 'compat-def ',realname)
,(funcall install-fn realname version))))
`(progn
(put ',realname 'compat-type ',type)
(put ',realname 'compat-version ,version)
(put ',realname 'compat-min-version ,min-version)
(put ',realname 'compat-max-version ,max-version)
(put ',realname 'compat-doc ,(plist-get attr :note))
,(funcall def-fn realname version)
(,@(cond
((or (and min-version
(version< emacs-version min-version))
(and max-version
(version< max-version emacs-version)))
'(compat--ignore))
((plist-get attr :prefix)
'(progn))
((and version (version<= version emacs-version) (not cond))
'(compat--ignore))
(`(when (and ,(if cond cond t)
,(funcall check-fn)))))
,(if feature
;; See https://nullprogram.com/blog/2018/02/22/:
`(eval-after-load ,feature `(funcall ',(lambda () ,body)))
body)))))
(defun compat-generate-common (name def-fn install-fn check-fn attr type)
"Common code for generating compatibility definitions.
See `compat-generate-function' for details on the arguments NAME,
DEF-FN, INSTALL-FN, CHECK-FN, ATTR and TYPE."
(when (and (plist-get attr :cond) (plist-get attr :prefix))
(error "A prefixed function %s cannot have a condition" name))
(funcall compat--generate-function
name def-fn install-fn check-fn attr type))
(defun compat-common-fdefine (type name arglist docstring rest)
"Generate compatibility code for a function NAME.
TYPE is one of `func', for functions and `macro' for macros, and
`advice' ARGLIST is passed on directly to the definition, and
DOCSTRING is prepended with a compatibility note. REST contains
the remaining definition, that may begin with a property list of
attributes (see `compat-generate-common')."
(let ((oldname name) (body rest))
(while (keywordp (car body))
(setq body (cddr body)))
;; It might be possible to set these properties otherwise. That
;; should be looked into and implemented if it is the case.
(when (and (listp (car-safe body)) (eq (caar body) 'declare))
(when (version<= emacs-version "25")
(delq (assq 'side-effect-free (car body)) (car body))
(delq (assq 'pure (car body)) (car body))))
;; Check if we want an explicitly prefixed function
(when (plist-get rest :prefix)
(setq name (intern (format "compat-%s" name))))
(compat-generate-common
name
(lambda (realname version)
`(,(cond
((memq type '(func advice)) 'defun)
((eq type 'macro) 'defmacro)
((error "Unknown type")))
,realname ,arglist
;; Prepend compatibility notice to the actual
;; documentation string.
,(let ((type (cond
((eq type 'func) "function")
((eq type 'macro) "macro")
((eq type 'advice) "advice")
((error "Unknown type")))))
(if version
(format
"[Compatibility %s for `%S', defined in Emacs %s]\n\n%s"
type oldname version docstring)
(format
"[Compatibility %s for `%S']\n\n%s"
type oldname docstring)))
;; Advice may use the implicit variable `oldfun', but
;; to avoid triggering the byte compiler, we make
;; sure the argument is used at least once.
,@(if (eq type 'advice)
(cons '(ignore oldfun) body)
body)))
(lambda (realname _version)
(cond
((memq type '(func macro))
;; Functions and macros are installed by
;; aliasing the name of the compatible
;; function to the name of the compatibility
;; function.
`(defalias ',name #',realname))
((eq type 'advice)
`(advice-add ',name :around #',realname))))
(lambda ()
(cond
((memq type '(func macro))
`(not (fboundp ',name)))
((eq type 'advice) t)))
rest type)))
(defmacro compat-defun (name arglist docstring &rest rest)
"Define NAME with arguments ARGLIST as a compatibility function.
The function must be documented in DOCSTRING. REST may begin
with a plist, that is interpreted by the macro but not passed on
to the actual function. See `compat-generate-common' for a
listing of attributes.
The definition will only be installed, if the version this
function was defined in, as indicated by the `:version'
attribute, is greater than the current Emacs version."
(declare (debug (&define name (&rest symbolp)
stringp
[&rest keywordp sexp]
def-body))
(doc-string 3) (indent 2))
(compat-common-fdefine 'func name arglist docstring rest))
(defmacro compat-defmacro (name arglist docstring &rest rest)
"Define NAME with arguments ARGLIST as a compatibility macro.
The macro must be documented in DOCSTRING. REST may begin
with a plist, that is interpreted by this macro but not passed on
to the actual macro. See `compat-generate-common' for a
listing of attributes.
The definition will only be installed, if the version this
function was defined in, as indicated by the `:version'
attribute, is greater than the current Emacs version."
(declare (debug compat-defun) (doc-string 3) (indent 2))
(compat-common-fdefine 'macro name arglist docstring rest))
(defmacro compat-advise (name arglist docstring &rest rest)
"Define NAME with arguments ARGLIST as a compatibility advice.
The advice function must be documented in DOCSTRING. REST may
begin with a plist, that is interpreted by this macro but not
passed on to the actual advice function. See
`compat-generate-common' for a listing of attributes. The advice
wraps the old definition, that is accessible via using the symbol
`oldfun'.
The advice will only be installed, if the version this function
was defined in, as indicated by the `:version' attribute, is
greater than the current Emacs version."
(declare (debug compat-defun) (doc-string 3) (indent 2))
(compat-common-fdefine 'advice name (cons 'oldfun arglist) docstring rest))
(defmacro compat-defvar (name initval docstring &rest attr)
"Declare compatibility variable NAME with initial value INITVAL.
The obligatory documentation string DOCSTRING must be given.
The remaining arguments ATTR form a plist, modifying the
behaviour of this macro. See `compat-generate-common' for a
listing of attributes. Furthermore, `compat-defvar' also handles
the attribute `:local' that either makes the variable permanent
local with a value of `permanent' or just buffer local with any
non-nil value."
(declare (debug (name form stringp [&rest keywordp sexp]))
(doc-string 3) (indent 2))
;; Check if we want an explicitly prefixed function
(let ((oldname name))
(when (plist-get attr :prefix)
(setq name (intern (format "compat-%s" name))))
(compat-generate-common
name
(lambda (realname version)
(let ((localp (plist-get attr :local)))
`(progn
(,(if (plist-get attr :constant) 'defconst 'defvar)
,realname ,initval
;; Prepend compatibility notice to the actual
;; documentation string.
,(if version
(format
"[Compatibility variable for `%S', defined in Emacs %s]\n\n%s"
oldname version docstring)
(format
"[Compatibility variable for `%S']\n\n%s"
oldname docstring)))
;; Make variable as local if necessary
,(cond
((eq localp 'permanent)
`(put ',realname 'permanent-local t))
(localp
`(make-variable-buffer-local ',realname))))))
(lambda (realname _version)
`(defvaralias ',name ',realname))
(lambda ()
`(not (boundp ',name)))
attr 'variable)))
(provide 'compat-macs)
;;; compat-macs.el ends here

2
org/elpa/compat-28.1.1.0/compat-pkg.el Normal file
View file

@ -0,0 +1,2 @@
;; Generated package description from compat.el -*- no-byte-compile: t -*-
(define-package "compat" "28.1.1.0" "Compatibility Library" '((emacs "24.3") (nadvice "0.3")) :commit "401df6defaf5ef470a2dc57664b2d258662a5c3d" :authors '(("Philip Kaludercic" . "philipk@posteo.net")) :maintainer '("Compat Development" . "~pkal/compat-devel@lists.sr.ht") :keywords '("lisp") :url "https://sr.ht/~pkal/compat")

99
org/elpa/compat-28.1.1.0/compat.el Normal file
View file

@ -0,0 +1,99 @@
;;; compat.el --- Compatibility Library -*- lexical-binding: t; -*-
;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
;; Author: Philip Kaludercic <philipk@posteo.net>
;; Maintainer: Compat Development <~pkal/compat-devel@lists.sr.ht>
;; Version: 28.1.1.0
;; URL: https://sr.ht/~pkal/compat
;; Package-Requires: ((emacs "24.3") (nadvice "0.3"))
;; Keywords: lisp
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; To allow for the usage of Emacs functions and macros that are
;; defined in newer versions of Emacs, compat.el provides definitions
;; that are installed ONLY if necessary. These reimplementations of
;; functions and macros are at least subsets of the actual
;; implementations. Be sure to read the documentation string to make
;; sure.
;;
;; Not every function provided in newer versions of Emacs is provided
;; here. Some depend on new features from the core, others cannot be
;; implemented to a meaningful degree. The main audience for this
;; library are not regular users, but package maintainers. Therefore
;; commands and user options are usually not implemented here.
;;; Code:
(eval-when-compile (require 'compat-macs))
;;;; Core functionality
;; To accelerate the loading process, we insert the contents of
;; compat-N.M.el directly into the compat.elc. Note that by default
;; this will not include prefix functions. These have to be required
;; separately, by explicitly requiring the feature that defines them.
(eval-when-compile
(defvar compat--generate-function)
(defmacro compat-entwine (version)
(cond
((or (not (eq compat--generate-function 'compat--generate-minimal))
(bound-and-true-p compat-testing))
`(load ,(format "compat-%d.el" version)))
((let* ((compat--generate-function 'compat--generate-minimal-no-prefix)
(file (expand-file-name
(format "compat-%d.el" version)
(file-name-directory
(or (if (fboundp 'macroexp-file-name)
(macroexp-file-name)
(or (bound-and-true-p byte-compile-current-file)
load-file-name))
(buffer-file-name)))))
defs)
(with-temp-buffer
(insert-file-contents file)
(emacs-lisp-mode)
(while (progn
(forward-comment 1)
(not (eobp)))
;; We bind `byte-compile-current-file' before
;; macro-expanding, so that `compat--generate-function'
;; can correctly infer the compatibility version currently
;; being processed.
(let ((byte-compile-current-file file)
(form (read (current-buffer))))
(cond
((memq (car-safe form)
'(compat-defun
compat-defmacro
compat-advise
compat-defvar))
(push (macroexpand-all form) defs))
((memq (car-safe form)
'(declare-function
defvar))
(push form defs))))))
(macroexp-progn (nreverse defs)))))))
(compat-entwine 24)
(compat-entwine 25)
(compat-entwine 26)
(compat-entwine 27)
(compat-entwine 28)
(provide 'compat)
;;; compat.el ends here

1110
org/elpa/compat-28.1.1.0/compat.info Normal file
View file

File diff suppressed because it is too large Load diff

18
org/elpa/compat-28.1.1.0/dir Normal file
View file

@ -0,0 +1,18 @@
This is the file .../info/dir, which contains the
topmost node of the Info hierarchy, called (dir)Top.
The first time you invoke Info you start off looking at this node.

File: dir, Node: Top This is the top of the INFO tree
This (the Directory node) gives a menu of major topics.
Typing "q" exits, "H" lists all Info commands, "d" returns here,
"h" gives a primer for first-timers,
"mEmacs<Return>" visits the Emacs manual, etc.
In Emacs, you can click mouse button 2 on a menu item or cross reference
to select it.
* Menu:
Emacs
* Compat: (compat). Compatibility Library for Emacs Lisp.

33
org/elpa/git-commit-20220422.1903/git-commit-autoloads.el Normal file
View file

@ -0,0 +1,33 @@
;;; git-commit-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*-
;;
;;; Code:
(add-to-list 'load-path (directory-file-name
(or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil "git-commit" "git-commit.el" (0 0 0 0))
;;; Generated autoloads from git-commit.el
(put 'git-commit-major-mode 'safe-local-variable
(lambda (val)
(memq val '(text-mode
markdown-mode
org-mode
fundamental-mode
git-commit-elisp-text-mode))))
(register-definition-prefixes "git-commit" '("git-commit-" "global-git-commit-mode"))
;;;***
;;;### (autoloads nil nil ("git-commit-pkg.el") (0 0 0 0))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; git-commit-autoloads.el ends here

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