emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
blob 54df5b9bafdbc39bc621c612e22fe267e29a9ab2 5584 bytes (raw)
name: lisp/org-attach-git.el 	 # note: path name is non-authoritative(*)

  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
 
;;; org-attach-git.el --- Automatic git commit extension to org-attach -*- lexical-binding: t; -*-

;; Copyright (C) 2019-2021 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-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 \\='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
  "The attachment directory where a Git repository must be
handled. The default value is `default', which is equivalent to
`org-attach-id-dir'. If the value is `individual-repository', it
means that the directory attached to the current node should be
handled as a individual repository, as long as it has been
conveniently initialized."
  :group 'org-attach
  :package-version '(Org . "9.0")
  :version "26.1"
  :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

debug log:

solving 54df5b9ba ...
found 54df5b9ba in https://yhetil.org/orgmode/87y2g8rj7s.fsf@posteo.net/
found 2091cbc61 in https://git.savannah.gnu.org/cgit/emacs/org-mode.git
preparing index
index prepared:
100644 2091cbc610c290ff28108148f6482fe6c3628ae9	lisp/org-attach-git.el

applying [1/1] https://yhetil.org/orgmode/87y2g8rj7s.fsf@posteo.net/
diff --git a/lisp/org-attach-git.el b/lisp/org-attach-git.el
index 2091cbc61..54df5b9ba 100644

Checking patch lisp/org-attach-git.el...
Applied patch lisp/org-attach-git.el cleanly.

index at:
100644 54df5b9bafdbc39bc621c612e22fe267e29a9ab2	lisp/org-attach-git.el

(*) Git path names are given by the tree(s) the blob belongs to.
    Blobs themselves have no identifier aside from the hash of its contents.^

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).