From mboxrd@z Thu Jan 1 00:00:00 1970 From: Erik Hetzner Subject: [PATCH] org-attach.el: Fetch attachments from git annex Date: Sun, 24 Jan 2016 20:34:20 -0800 Message-ID: <56a70513.6861420a.33633.5843@mx.google.com> References: <568b532e.d111620a.b25a8.ffffbb7c@mx.google.com> <87poxg8s22.fsf@kyleam.com> <568c6aaa.c345620a.7f4da.6359@mx.google.com> <56a5b193.ca77420a.1551e.667c@mx.google.com> <87lh7dz79f.fsf@gmx.us> Reply-To: Erik Hetzner Mime-Version: 1.0 (generated by SEMI-EPG 1.14.7 - "Harue") Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: quoted-printable Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:35289) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1aNwFc-0003u4-P5 for emacs-orgmode@gnu.org; Tue, 26 Jan 2016 00:33:14 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1aNwFZ-0001Ha-I1 for emacs-orgmode@gnu.org; Tue, 26 Jan 2016 00:33:12 -0500 Received: from mail-pf0-x22a.google.com ([2607:f8b0:400e:c00::22a]:36489) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1aNwFZ-0001HV-6n for emacs-orgmode@gnu.org; Tue, 26 Jan 2016 00:33:09 -0500 Received: by mail-pf0-x22a.google.com with SMTP id n128so93830523pfn.3 for ; Mon, 25 Jan 2016 21:33:09 -0800 (PST) Received: from marut.e6h.org (50-0-83-149.dsl.static.fusionbroadband.com. [50.0.83.149]) by smtp.gmail.com with ESMTPSA id dz8sm32424681pab.19.2016.01.25.21.33.07 for (version=TLS1_2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); Mon, 25 Jan 2016 21:33:07 -0800 (PST) In-Reply-To: <87lh7dz79f.fsf@gmx.us> List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Sender: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org To: emacs-orgmode@gnu.org * org-attach.el (org-attach-use-annex): New function to check if git annex should be used. (org-attach-annex-get-maybe): New function to get a file from git annex if necessary. (org-annex-open): Automatically fetch attached files from git annex when opening if necessary. * testing/lisp/test-org-annex.el: New file for testing org-attach. Only contains code for testing org-attach with git annex at the moment. * mk/targets.mk: Fix cleantest target to for deleting git annex repos. --- Changes per Rasmus=E2=80=99s feedback. lisp/org-attach.el | 43 ++++++++++++++-------- mk/targets.mk | 2 + testing/lisp/test-org-attach.el | 81 +++++++++++++++++++++++++++++++++++++= ++++ 3 files changed, 110 insertions(+), 16 deletions(-) create mode 100644 testing/lisp/test-org-attach.el diff --git a/lisp/org-attach.el b/lisp/org-attach.el index e6ad4b1..1085ad3 100644 --- a/lisp/org-attach.el +++ b/lisp/org-attach.el @@ -270,29 +270,38 @@ the ATTACH_DIR property) their own attachment directo= ry." (org-entry-put nil "ATTACH_DIR_INHERIT" "t") (message "Children will inherit attachment directory")) =20 +(defun org-attach-use-annex () + "Return non-nil if git annex can be used." + (let ((git-dir (vc-git-root (expand-file-name org-attach-directory)))) + (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-annex-get-maybe (path) + "Call git annex get PATH if using git annex." + (if (org-attach-use-annex) + (call-process "git" nil nil nil "annex" "get" path))) + (defun org-attach-commit () "Commit changes to git if `org-attach-directory' is properly initialized. This checks for the existence of a \".git\" directory in that directory." (let* ((dir (expand-file-name org-attach-directory)) (git-dir (vc-git-root dir)) + (use-annex (org-attach-use-annex)) (changes 0)) (when (and git-dir (executable-find "git")) (with-temp-buffer (cd dir) - (let ((have-annex - (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)))))) - (dolist (new-or-modified - (split-string - (shell-command-to-string - "git ls-files -zmo --exclude-standard") "\0" t)) - (if (and have-annex - (>=3D (nth 7 (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)) - (incf changes))) + (dolist (new-or-modified + (split-string + (shell-command-to-string + "git ls-files -zmo --exclude-standard") "\0" t)) + (if (and use-annex + (>=3D (nth 7 (file-attributes new-or-modified)) + org-attach-git-annex-cutoff)) + (call-process "git" nil nil nil "annex" "add" new-or-modifie= d) + (call-process "git" nil nil nil "add" new-or-modified)) + (incf changes)) (dolist (deleted (split-string (shell-command-to-string "git ls-files -z --deleted") "\0" t)) @@ -465,8 +474,10 @@ If IN-EMACS is non-nil, force opening in Emacs." (file (if (=3D (length files) 1) (car files) (completing-read "Open attachment: " - (mapcar #'list files) nil t)))) - (org-open-file (expand-file-name file attach-dir) in-emacs))) + (mapcar #'list files) nil t))) + (path (expand-file-name file attach-dir))) + (org-attach-annex-get-maybe path) + (org-open-file path in-emacs))) =20 (defun org-attach-open-in-emacs () "Open attachment, force opening in Emacs. diff --git a/mk/targets.mk b/mk/targets.mk index d390fdb..8eb02fd 100644 --- a/mk/targets.mk +++ b/mk/targets.mk @@ -158,4 +158,6 @@ cleandocs: -$(FIND) doc -name \*~ -exec $(RM) {} \; =20 cleantest: + # git annex makes files 444, change to user writableso we can delete them + chmod u+w -R $(testdir) $(RMR) $(testdir) diff --git a/testing/lisp/test-org-attach.el b/testing/lisp/test-org-attach= .el new file mode 100644 index 0000000..7f02e2d --- /dev/null +++ b/testing/lisp/test-org-attach.el @@ -0,0 +1,81 @@ +;;; test-org-attach.el --- Tests for Org Attach +;; +;; Copyright (c) 2016 Erik Hetzner +;; Authors: Erik Hetzner + +;; This file is not part of GNU Emacs. + +;; 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 . + +;;; Code: +(require 'org-attach) + +(cl-defmacro test-org-attach-annex/with-annex (&body body) + `(let ((tmpdir (make-temp-file "org-annex-test" t))) + (unwind-protect + (let ((default-directory tmpdir) + (org-attach-directory tmpdir)) + (shell-command "git init") + (shell-command "git annex init") + ,@body)))) + +(ert-deftest test-org-attach/use-annex () + (org-test-for-executable "git-annex") + ;; (skip-unless (test-org-attach-annex/installed)) + (test-org-attach-annex/with-annex + (let ((org-attach-git-annex-cutoff 1)) + (should (org-attach-use-annex))) + + (let ((org-attach-git-annex-cutoff nil)) + (should-not (org-attach-use-annex)))) + + ;; test with non annex directory + (let ((tmpdir (make-temp-file "org-annex-test" t))) + (unwind-protect + (let ((default-directory tmpdir) + (org-attach-directory tmpdir)) + (shell-command "git init") + (should-not (org-attach-use-annex))) + (delete-directory tmpdir 'recursive)))) + +(ert-deftest test-org-attach/get-maybe () + (org-test-for-executable "git-annex") + ;; (skip-unless (test-org-attach-annex/installed)) + (test-org-attach-annex/with-annex + (let ((path (expand-file-name "test-file")) + (annex-dup (make-temp-file "org-annex-test" t))) + (with-temp-buffer + (insert "hello world\n") + (write-file path)) + (shell-command "git annex add test-file") + (shell-command "git annex sync") + ;; Set up remote & copy files there + (let ((annex-original default-directory) + (default-directory annex-dup)) + (shell-command (format "git clone %s ." (shell-quote-argument annex= -original))) + (shell-command "git annex init dup") + (shell-command (format "git remote add original %s" (shell-quote-ar= gument annex-original))) + (shell-command "git annex get test-file") + (shell-command "git annex sync")) + (shell-command (format "git remote add dup %s" (shell-quote-argument = annex-dup))) + (shell-command "git annex sync") + (shell-command "git annex drop --force test-file") + ;; test getting the file from the dup + (org-attach-annex-get-maybe (expand-file-name "test-file")) + ;; check that the file has the right contents + (with-temp-buffer + (insert-file-contents path) + (should (string-equal "hello world\n" (buffer-string))))))) + +;;; test-org-attach.el ends here --=20 2.5.0