diff options
Diffstat (limited to 'lisp/org/org-attach.el')
| -rw-r--r-- | lisp/org/org-attach.el | 154 |
1 files changed, 112 insertions, 42 deletions
diff --git a/lisp/org/org-attach.el b/lisp/org/org-attach.el index 7d25437d9f5..a026eee4f13 100644 --- a/lisp/org/org-attach.el +++ b/lisp/org/org-attach.el @@ -1,4 +1,4 @@ -;;; org-attach.el --- Manage file attachments to org-mode tasks +;;; org-attach.el --- Manage file attachments to Org tasks -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2017 Free Software Foundation, Inc. @@ -22,7 +22,7 @@ ;;; Commentary: -;; See the Org-mode manual for information on how to use it. +;; See the Org manual for information on how to use it. ;; ;; Attachments are managed in a special directory called "data", which ;; lives in the same directory as the org file itself. If this data @@ -37,14 +37,13 @@ ;;; Code: -(eval-when-compile - (require 'cl)) -(require 'org-id) +(require 'cl-lib) (require 'org) +(require 'org-id) (require 'vc-git) (defgroup org-attach nil - "Options concerning entry attachments in Org-mode." + "Options concerning entry attachments in Org mode." :tag "Org Attach" :group 'org) @@ -55,6 +54,14 @@ where the Org file lives." :group 'org-attach :type 'directory) +(defcustom org-attach-commit t + "If non-nil commit attachments with git. +This is only done if the Org file is in a git repository." + :group 'org-attach + :type 'boolean + :version "26.1" + :package-version '(Org . "9.0")) + (defcustom org-attach-git-annex-cutoff (* 32 1024) "If non-nil, files larger than this will be annexed instead of stored." :group 'org-attach @@ -120,6 +127,28 @@ lns create a symbol link. Note that this is not supported (const :tag "Link to origin location" t) (const :tag "Link to the attach-dir location" attached))) +(defcustom org-attach-archive-delete nil + "Non-nil means attachments are deleted upon archiving a subtree. +When set to `query', ask the user instead." + :group 'org-attach + :version "26.1" + :package-version '(Org . "8.3") + :type '(choice + (const :tag "Never delete attachments" nil) + (const :tag "Always delete attachments" t) + (const :tag "Query the user" query))) + +(defcustom org-attach-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") + :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))) + ;;;###autoload (defun org-attach () "The dispatcher for attachment commands. @@ -197,25 +226,23 @@ using the entry ID will be invoked to access the unique directory for the current entry. If the directory does not exist and CREATE-IF-NOT-EXISTS-P is non-nil, the directory and (if necessary) the corresponding ID will be created." - (let (attach-dir uuid inherit) + (let (attach-dir uuid) (setq org-attach-inherited (org-entry-get nil "ATTACH_DIR_INHERIT")) (cond ((setq attach-dir (org-entry-get nil "ATTACH_DIR")) (org-attach-check-absolute-path attach-dir)) ((and org-attach-allow-inheritance - (setq inherit (org-entry-get nil "ATTACH_DIR_INHERIT" t))) + (org-entry-get nil "ATTACH_DIR_INHERIT" t)) (setq attach-dir - (save-excursion - (save-restriction - (widen) - (if (marker-position org-entry-property-inherited-from) - (goto-char org-entry-property-inherited-from) - (org-back-to-heading t)) - (let (org-attach-allow-inheritance) - (org-attach-dir create-if-not-exists-p))))) + (org-with-wide-buffer + (if (marker-position org-entry-property-inherited-from) + (goto-char org-entry-property-inherited-from) + (org-back-to-heading t)) + (let (org-attach-allow-inheritance) + (org-attach-dir create-if-not-exists-p)))) (org-attach-check-absolute-path attach-dir) (setq org-attach-inherited t)) - (t ; use the ID + (t ; use the ID (org-attach-check-absolute-path nil) (setq uuid (org-id-get (point) create-if-not-exists-p)) (when (or uuid create-if-not-exists-p) @@ -261,33 +288,59 @@ 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-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 ((path-relative (file-relative-name path))) + (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-relative)))))) + (let ((should-get + (if (eq org-attach-annex-auto-get 'ask) + (y-or-n-p (format "Run git annex get %s? " path-relative)) + org-attach-annex-auto-get))) + (if should-get + (progn (message "Running git annex get \"%s\"." path-relative) + (call-process "git" nil nil nil "annex" "get" path-relative)) + (error "File %s stored in git annex but it is not available, and was not retrieved" + 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 - (file-exists-p (expand-file-name "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 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)) + (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) - (incf changes)) + (cl-incf changes)) (when (> changes 0) (shell-command "git commit -m 'Synchronized attachments'")))))) @@ -328,7 +381,8 @@ METHOD may be `cp', `mv', `ln', or `lns' default taken from ((eq method 'cp) (copy-file file fname)) ((eq method 'ln) (add-name-to-file file fname)) ((eq method 'lns) (make-symbolic-link file fname))) - (org-attach-commit) + (when org-attach-commit + (org-attach-commit)) (org-attach-tag) (cond ((eq org-attach-store-link-p 'attached) (org-attach-store-link fname)) @@ -378,7 +432,7 @@ The attachment is created as an Emacs buffer." (let* ((attach-dir (org-attach-dir t)) (files (org-attach-file-list attach-dir)) (file (or file - (org-icompleting-read + (completing-read "Delete attachment: " (mapcar (lambda (f) (list (file-name-nondirectory f))) @@ -387,7 +441,8 @@ The attachment is created as an Emacs buffer." (unless (file-exists-p file) (error "No such attachment: %s" file)) (delete-file file) - (org-attach-commit))) + (when org-attach-commit + (org-attach-commit)))) (defun org-attach-delete-all (&optional force) "Delete all attachments from the current task. @@ -403,14 +458,16 @@ A safer way is to open the directory in dired and delete from there." (y-or-n-p "Are you sure you want to remove all attachments of this entry? "))) (shell-command (format "rm -fr %s" attach-dir)) (message "Attachment directory removed") - (org-attach-commit) + (when org-attach-commit + (org-attach-commit)) (org-attach-untag)))) (defun org-attach-sync () "Synchronize the current tasks with its attachments. This can be used after files have been added externally." (interactive) - (org-attach-commit) + (when org-attach-commit + (org-attach-commit)) (when (and org-attach-file-list-property (not org-attach-inherited)) (org-entry-delete (point) org-attach-file-list-property)) (let ((attach-dir (org-attach-dir))) @@ -419,15 +476,15 @@ This can be used after files have been added externally." (and files (org-attach-tag)) (when org-attach-file-list-property (dolist (file files) - (unless (string-match "^\\." file) + (unless (string-match "^\\.\\.?\\'" file) (org-entry-add-to-multivalued-property (point) org-attach-file-list-property file)))))))) (defun org-attach-file-list (dir) "Return a list of files in the attachment directory. -This ignores files starting with a \".\", and files ending in \"~\"." +This ignores files ending in \"~\"." (delq nil - (mapcar (lambda (x) (if (string-match "^\\." x) nil x)) + (mapcar (lambda (x) (if (string-match "^\\.\\.?\\'" x) nil x)) (directory-files dir nil "[^~]\\'")))) (defun org-attach-reveal (&optional if-exists) @@ -454,9 +511,11 @@ If IN-EMACS is non-nil, force opening in Emacs." (files (org-attach-file-list attach-dir)) (file (if (= (length files) 1) (car files) - (org-icompleting-read "Open attachment: " - (mapcar 'list files) nil t)))) - (org-open-file (expand-file-name file attach-dir) in-emacs))) + (completing-read "Open attachment: " + (mapcar #'list files) nil t))) + (path (expand-file-name file attach-dir))) + (org-attach-annex-get-maybe path) + (org-open-file path in-emacs))) (defun org-attach-open-in-emacs () "Open attachment, force opening in Emacs. @@ -475,6 +534,17 @@ Basically, this adds the path to the attachment directory, and a \"file:\" prefix." (concat "file:" (org-attach-expand file))) +(defun org-attach-archive-delete-maybe () + "Maybe delete subtree attachments when archiving. +This function is called by `org-archive-hook'. The option +`org-attach-archive-delete' controls its behavior." + (when (if (eq org-attach-archive-delete 'query) + (yes-or-no-p "Delete all attachments? ") + org-attach-archive-delete) + (org-attach-delete-all t))) + +(add-hook 'org-archive-hook 'org-attach-archive-delete-maybe) + (provide 'org-attach) ;; Local variables: |