emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
blob 95a2359c3b74bf573c153fac7b95146bd31df7ed 5705 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
143
144
145
146
 
;;; org-attach-git.el --- Automatic git commit extension to org-attach -*- lexical-binding: t; -*-

;; Copyright (C) 2019-2022 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-macs)
(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

debug log:

solving 95a2359c3 ...
found 95a2359c3 in https://git.savannah.gnu.org/cgit/emacs/org-mode.git

(*) 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).