1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
| | ;;; org-attach-git.el --- Automatic git commit extension to org-attach -*- lexical-binding: t; -*-
;; Copyright (C) 2019-2023 Free Software Foundation, Inc.
;; Original Author: John Wiegley <johnw@newartisans.com>
;; Restructurer: Gustav Wikström <gustav@whil.se>
;; Keywords: org data git
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; An extension to org-attach. If `org-attach-id-dir' is initialized
;; as a Git repository, then `org-attach-git' will automatically commit
;; changes when it sees them. Requires git-annex.
;;; Code:
(require 'org-load)
(org-assert-version)
(require 'org-attach)
(require 'vc-git)
(defcustom org-attach-git-annex-cutoff (* 32 1024)
"If non-nil, files larger than this will be annexed instead of stored."
:group 'org-attach
:version "24.4"
:package-version '(Org . "8.0")
:type '(choice
(const :tag "None" nil)
(integer :tag "Bytes")))
(defcustom org-attach-git-annex-auto-get 'ask
"Confirmation preference for automatically getting annex files.
If this is the symbol `ask', prompt using `y-or-n-p'.
If t, always get. If nil, never get."
:group 'org-attach
:package-version '(Org . "9.0")
:version "26.1"
:type '(choice
(const :tag "confirm with `y-or-n-p'" ask)
(const :tag "always get from annex if necessary" t)
(const :tag "never get from annex" nil)))
(defcustom org-attach-git-dir 'default
"Attachment directory with the Git repository to use.
The default value is to use `org-attach-id-dir'. When set to
`individual-repository', then the directory attached to the
current node, if correctly initialized as a Git repository, will
be used instead."
:group 'org-attach
:package-version '(Org . "9.5")
:type '(choice
(const :tag "Default" default)
(const :tag "Individual repository" individual-repository)))
(defun org-attach-git-use-annex ()
"Return non-nil if git annex can be used."
(let ((git-dir (vc-git-root
(cond ((eq org-attach-git-dir 'default)
(expand-file-name org-attach-id-dir))
((eq org-attach-git-dir 'individual-repository)
(org-attach-dir))))))
(and org-attach-git-annex-cutoff
(or (file-exists-p (expand-file-name "annex" git-dir))
(file-exists-p (expand-file-name ".git/annex" git-dir))))))
(defun org-attach-git-annex-get-maybe (path)
"Call git annex get PATH (via shell) if using git annex.
Signals an error if the file content is not available and it was not retrieved."
(let* ((default-directory
(cond ((eq org-attach-git-dir 'default)
(expand-file-name org-attach-id-dir))
((eq org-attach-git-dir 'individual-repository)
(org-attach-dir))))
(path-relative (file-relative-name path)))
(when (and (org-attach-git-use-annex)
(not
(string-equal
"found"
(shell-command-to-string
(format "git annex find --format=found --in=here %s"
(shell-quote-argument path-relative))))))
(let ((should-get
(if (eq org-attach-git-annex-auto-get 'ask)
(y-or-n-p (format "Run git annex get %s? " path-relative))
org-attach-git-annex-auto-get)))
(unless should-get
(error "File %s stored in git annex but unavailable" path))
(message "Running git annex get \"%s\"." path-relative)
(call-process "git" nil nil nil "annex" "get" path-relative)))))
(defun org-attach-git-commit (&optional _)
"Commit changes to git if `org-attach-id-dir' is properly initialized.
This checks for the existence of a \".git\" directory in that directory.
Takes an unused optional argument for the sake of being compatible
with hook `org-attach-after-change-hook'."
(let* ((dir (cond ((eq org-attach-git-dir 'default)
(expand-file-name org-attach-id-dir))
((eq org-attach-git-dir 'individual-repository)
(org-attach-dir))))
(git-dir (vc-git-root dir))
(use-annex (org-attach-git-use-annex))
(changes 0))
(when (and git-dir (executable-find "git"))
(with-temp-buffer
(cd dir)
(dolist (new-or-modified
(split-string
(shell-command-to-string
"git ls-files -zmo --exclude-standard") "\0" t))
(if (and use-annex
(>= (file-attribute-size (file-attributes new-or-modified))
org-attach-git-annex-cutoff))
(call-process "git" nil nil nil "annex" "add" new-or-modified)
(call-process "git" nil nil nil "add" new-or-modified))
(cl-incf changes))
(dolist (deleted
(split-string
(shell-command-to-string "git ls-files -z --deleted") "\0" t))
(call-process "git" nil nil nil "rm" deleted)
(cl-incf changes))
(when (> changes 0)
(shell-command "git commit -m 'Synchronized attachments'"))))))
(add-hook 'org-attach-after-change-hook 'org-attach-git-commit)
(add-hook 'org-attach-open-hook 'org-attach-git-annex-get-maybe)
(provide 'org-attach-git)
;;; org-attach-git.el ends here
|