add magit packages
This commit is contained in:
parent
64e65c2bf7
commit
2fe771c235
1
code/elpa/compat-28.1.1.0.signed
Normal file
1
code/elpa/compat-28.1.1.0.signed
Normal 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
40
code/elpa/compat-28.1.1.0/NEWS.org
Normal 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
516
code/elpa/compat-28.1.1.0/compat-24.el
Normal 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
317
code/elpa/compat-28.1.1.0/compat-25.el
Normal 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
623
code/elpa/compat-28.1.1.0/compat-26.el
Normal 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
642
code/elpa/compat-28.1.1.0/compat-27.el
Normal 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
835
code/elpa/compat-28.1.1.0/compat-28.el
Normal 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
35
code/elpa/compat-28.1.1.0/compat-autoloads.el
Normal 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
48
code/elpa/compat-28.1.1.0/compat-font-lock.el
Normal 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
57
code/elpa/compat-28.1.1.0/compat-help.el
Normal 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
367
code/elpa/compat-28.1.1.0/compat-macs.el
Normal 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
2
code/elpa/compat-28.1.1.0/compat-pkg.el
Normal 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
99
code/elpa/compat-28.1.1.0/compat.el
Normal 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
1110
code/elpa/compat-28.1.1.0/compat.info
Normal file
File diff suppressed because it is too large
Load diff
18
code/elpa/compat-28.1.1.0/dir
Normal file
18
code/elpa/compat-28.1.1.0/dir
Normal 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
33
code/elpa/git-commit-20220422.1903/git-commit-autoloads.el
Normal 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
18
code/elpa/git-commit-20220422.1903/git-commit-pkg.el
Normal 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
1141
code/elpa/git-commit-20220422.1903/git-commit.el
Normal file
File diff suppressed because it is too large
Load diff
393
code/elpa/magit-20220425.1153/AUTHORS.md
Normal file
393
code/elpa/magit-20220425.1153/AUTHORS.md
Normal 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
674
code/elpa/magit-20220425.1153/LICENSE
Normal 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
18
code/elpa/magit-20220425.1153/dir
Normal 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
848
code/elpa/magit-20220425.1153/git-rebase.el
Normal 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
806
code/elpa/magit-20220425.1153/magit-apply.el
Normal 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
2601
code/elpa/magit-20220425.1153/magit-autoloads.el
Normal file
File diff suppressed because it is too large
Load diff
261
code/elpa/magit-20220425.1153/magit-autorevert.el
Normal file
261
code/elpa/magit-20220425.1153/magit-autorevert.el
Normal 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
1273
code/elpa/magit-20220425.1153/magit-base.el
Normal file
File diff suppressed because it is too large
Load diff
307
code/elpa/magit-20220425.1153/magit-bisect.el
Normal file
307
code/elpa/magit-20220425.1153/magit-bisect.el
Normal 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
981
code/elpa/magit-20220425.1153/magit-blame.el
Normal 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
205
code/elpa/magit-20220425.1153/magit-bookmark.el
Normal 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
934
code/elpa/magit-20220425.1153/magit-branch.el
Normal 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
132
code/elpa/magit-20220425.1153/magit-bundle.el
Normal 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
327
code/elpa/magit-20220425.1153/magit-clone.el
Normal 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
717
code/elpa/magit-20220425.1153/magit-commit.el
Normal 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
129
code/elpa/magit-20220425.1153/magit-core.el
Normal 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
3435
code/elpa/magit-20220425.1153/magit-diff.el
Normal file
File diff suppressed because it is too large
Load diff
483
code/elpa/magit-20220425.1153/magit-ediff.el
Normal file
483
code/elpa/magit-20220425.1153/magit-ediff.el
Normal 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
916
code/elpa/magit-20220425.1153/magit-extras.el
Normal 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
199
code/elpa/magit-20220425.1153/magit-fetch.el
Normal 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
535
code/elpa/magit-20220425.1153/magit-files.el
Normal 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
2633
code/elpa/magit-20220425.1153/magit-git.el
Normal file
File diff suppressed because it is too large
Load diff
195
code/elpa/magit-20220425.1153/magit-gitignore.el
Normal file
195
code/elpa/magit-20220425.1153/magit-gitignore.el
Normal 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
1938
code/elpa/magit-20220425.1153/magit-log.el
Normal file
File diff suppressed because it is too large
Load diff
239
code/elpa/magit-20220425.1153/magit-margin.el
Normal file
239
code/elpa/magit-20220425.1153/magit-margin.el
Normal 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
318
code/elpa/magit-20220425.1153/magit-merge.el
Normal 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
1547
code/elpa/magit-20220425.1153/magit-mode.el
Normal file
File diff suppressed because it is too large
Load diff
201
code/elpa/magit-20220425.1153/magit-notes.el
Normal file
201
code/elpa/magit-20220425.1153/magit-notes.el
Normal 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
111
code/elpa/magit-20220425.1153/magit-obsolete.el
Normal 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
326
code/elpa/magit-20220425.1153/magit-patch.el
Normal 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
19
code/elpa/magit-20220425.1153/magit-pkg.el
Normal 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
1220
code/elpa/magit-20220425.1153/magit-process.el
Normal file
File diff suppressed because it is too large
Load diff
165
code/elpa/magit-20220425.1153/magit-pull.el
Normal file
165
code/elpa/magit-20220425.1153/magit-pull.el
Normal 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
341
code/elpa/magit-20220425.1153/magit-push.el
Normal 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
210
code/elpa/magit-20220425.1153/magit-reflog.el
Normal 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
774
code/elpa/magit-20220425.1153/magit-refs.el
Normal 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
368
code/elpa/magit-20220425.1153/magit-remote.el
Normal 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
543
code/elpa/magit-20220425.1153/magit-repos.el
Normal 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
134
code/elpa/magit-20220425.1153/magit-reset.el
Normal 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
1087
code/elpa/magit-20220425.1153/magit-sequence.el
Normal file
File diff suppressed because it is too large
Load diff
170
code/elpa/magit-20220425.1153/magit-sparse-checkout.el
Normal file
170
code/elpa/magit-20220425.1153/magit-sparse-checkout.el
Normal 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
566
code/elpa/magit-20220425.1153/magit-stash.el
Normal 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
833
code/elpa/magit-20220425.1153/magit-status.el
Normal 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
719
code/elpa/magit-20220425.1153/magit-submodule.el
Normal 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
181
code/elpa/magit-20220425.1153/magit-subtree.el
Normal 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
236
code/elpa/magit-20220425.1153/magit-tag.el
Normal 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
220
code/elpa/magit-20220425.1153/magit-transient.el
Normal 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
453
code/elpa/magit-20220425.1153/magit-wip.el
Normal 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
191
code/elpa/magit-20220425.1153/magit-worktree.el
Normal 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
683
code/elpa/magit-20220425.1153/magit.el
Normal 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
11184
code/elpa/magit-20220425.1153/magit.info
Normal file
File diff suppressed because it is too large
Load diff
19
code/elpa/magit-section-20220425.1002/dir
Normal file
19
code/elpa/magit-section-20220425.1002/dir
Normal 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.
|
|
@ -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
14
code/elpa/magit-section-20220425.1002/magit-section-pkg.el
Normal 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
2202
code/elpa/magit-section-20220425.1002/magit-section.el
Normal file
File diff suppressed because it is too large
Load diff
307
code/elpa/magit-section-20220425.1002/magit-section.info
Normal file
307
code/elpa/magit-section-20220425.1002/magit-section.info
Normal 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
18
code/elpa/transient-20220425.1314/dir
Normal 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
80
code/elpa/transient-20220425.1314/transient-autoloads.el
Normal 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
13
code/elpa/transient-20220425.1314/transient-pkg.el
Normal 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
4073
code/elpa/transient-20220425.1314/transient.el
Normal file
File diff suppressed because it is too large
Load diff
2648
code/elpa/transient-20220425.1314/transient.info
Normal file
2648
code/elpa/transient-20220425.1314/transient.info
Normal file
File diff suppressed because it is too large
Load diff
18
code/elpa/with-editor-20220422.1628/dir
Normal file
18
code/elpa/with-editor-20220422.1628/dir
Normal 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
111
code/elpa/with-editor-20220422.1628/with-editor-autoloads.el
Normal 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
13
code/elpa/with-editor-20220422.1628/with-editor-pkg.el
Normal 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
949
code/elpa/with-editor-20220422.1628/with-editor.el
Normal 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
382
code/elpa/with-editor-20220422.1628/with-editor.info
Normal 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
|
||||||
|
*************************************
|
||||||
|
|
||||||
|
|