From mboxrd@z Thu Jan 1 00:00:00 1970 From: Erik Hetzner Subject: Re: [PATCH] org-attach.el: Fetch attachments from git annex Date: Sun, 24 Jan 2016 21:24:32 -0800 Message-ID: <56a5b193.ca77420a.1551e.667c@mx.google.com> References: <568b532e.d111620a.b25a8.ffffbb7c@mx.google.com> <87poxg8s22.fsf@kyleam.com> <568c6aaa.c345620a.7f4da.6359@mx.google.com> Reply-To: Erik Hetzner Mime-Version: 1.0 (generated by SEMI-EPG 1.14.7 - "Harue") Content-Type: text/plain; charset=US-ASCII Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:57729) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1aNZdr-0005tq-II for emacs-orgmode@gnu.org; Mon, 25 Jan 2016 00:24:45 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1aNZdn-0003KV-5G for emacs-orgmode@gnu.org; Mon, 25 Jan 2016 00:24:42 -0500 Received: from mail-pf0-x236.google.com ([2607:f8b0:400e:c00::236]:36205) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1aNZdm-0003KF-QD for emacs-orgmode@gnu.org; Mon, 25 Jan 2016 00:24:39 -0500 Received: by mail-pf0-x236.google.com with SMTP id n128so75954234pfn.3 for ; Sun, 24 Jan 2016 21:24:36 -0800 (PST) In-Reply-To: <568c6aaa.c345620a.7f4da.6359@mx.google.com> 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 Cc: Kyle Meyer * org-attach.el (org-attach-use-annex): New function to check if git annex should be used. (org-attach-annex-fetch-maybe): New function to fetch 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. --- I have finally updated this patch per the feedback on the list. I have also added some tests of the git annex attach code. Thanks for all the feedback. lisp/org-attach.el | 46 +++++++++++++++-------- testing/lisp/test-org-attach.el | 81 +++++++++++++++++++++++++++++++++++++++++ 2 files changed, 111 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..3500e26 100644 --- a/lisp/org-attach.el +++ b/lisp/org-attach.el @@ -270,6 +270,22 @@ the ATTACH_DIR property) their own attachment directory." (org-entry-put nil "ATTACH_DIR_INHERIT" "t") (message "Children will inherit attachment directory")) +(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-fetch-maybe (path) + "Fetch PATH from git annex if necessary." + (when (and (org-attach-use-annex) + (not (string-equal "found" + (shell-command-to-string + (format "git annex find --format=found --in=here %s" (shell-quote-argument path)))))) + (message "Fetching \"%s\" using git annex." path) + (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." @@ -279,20 +295,16 @@ This checks for the existence of a \".git\" directory in that directory." (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 - (>= (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 (org-attach-use-annex) + (>= (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 (deleted (split-string (shell-command-to-string "git ls-files -z --deleted") "\0" t)) @@ -465,8 +477,10 @@ If IN-EMACS is non-nil, force opening in Emacs." (file (if (= (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-fetch-maybe path) + (org-open-file path in-emacs))) (defun org-attach-open-in-emacs () "Open attachment, force opening in Emacs. diff --git a/testing/lisp/test-org-attach.el b/testing/lisp/test-org-attach.el new file mode 100644 index 0000000..7f435bd --- /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/fetch-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-argument 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-fetch-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 -- 2.5.0