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