|
@@ -1,9 +1,9 @@
|
|
|
-;;; org-attach.el --- Manage file attachments to Org tasks -*- lexical-binding: t; -*-
|
|
|
+;;; org-attach.el --- Manage file attachments to Org outlines -*- lexical-binding: t; -*-
|
|
|
|
|
|
;; Copyright (C) 2008-2019 Free Software Foundation, Inc.
|
|
|
|
|
|
;; Author: John Wiegley <johnw@newartisans.com>
|
|
|
-;; Keywords: org data task
|
|
|
+;; Keywords: org data attachment
|
|
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
;;
|
|
@@ -24,32 +24,30 @@
|
|
|
|
|
|
;; 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
|
|
|
-;; directory is initialized as a Git repository, then org-attach will
|
|
|
-;; automatically commit changes when it sees them.
|
|
|
-;;
|
|
|
-;; Attachment directories are identified using a UUID generated for the
|
|
|
-;; task which has the attachments. These are added as property to the
|
|
|
-;; task when necessary, and should not be deleted or changed by the
|
|
|
-;; user, ever. UUIDs are generated by a mechanism defined in the variable
|
|
|
-;; `org-id-method'.
|
|
|
+;; Attachments are managed either by using a custom property DIR or by
|
|
|
+;; using property ID from org-id. When DIR is defined, a location in
|
|
|
+;; the filesystem is directly attached to the outline node. When
|
|
|
+;; org-id is used, attachments are stored in a folder named after the
|
|
|
+;; ID, in a location defined by `org-attach-id-dir'. DIR has
|
|
|
+;; precedence over ID when both parameters are defined for the current
|
|
|
+;; outline node (also when inherited parameters are taken into
|
|
|
+;; account).
|
|
|
|
|
|
;;; Code:
|
|
|
|
|
|
(require 'cl-lib)
|
|
|
(require 'org)
|
|
|
+(require 'ol)
|
|
|
(require 'org-id)
|
|
|
-(require 'vc-git)
|
|
|
|
|
|
(declare-function dired-dwim-target-directory "dired-aux")
|
|
|
|
|
|
(defgroup org-attach nil
|
|
|
- "Options concerning entry attachments in Org mode."
|
|
|
+ "Options concerning attachments in Org mode."
|
|
|
:tag "Org Attach"
|
|
|
:group 'org)
|
|
|
|
|
|
-(defcustom org-attach-directory "data/"
|
|
|
+(defcustom org-attach-id-dir "data/"
|
|
|
"The directory where attachments are stored.
|
|
|
If this is a relative path, it will be interpreted relative to the directory
|
|
|
where the Org file lives."
|
|
@@ -57,22 +55,13 @@ where the Org file lives."
|
|
|
:type 'directory
|
|
|
:safe #'stringp)
|
|
|
|
|
|
-(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."
|
|
|
+(defcustom org-attach-dir-relative nil
|
|
|
+ "Non-nil means directories in DIR property are added as relative links.
|
|
|
+Defaults to absolute location."
|
|
|
: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
|
|
|
- :version "24.4"
|
|
|
- :package-version '(Org . "8.0")
|
|
|
- :type '(choice
|
|
|
- (const :tag "None" nil)
|
|
|
- (integer :tag "Bytes")))
|
|
|
+ :package-version '(Org . "9.3")
|
|
|
+ :safe #'booleanp)
|
|
|
|
|
|
(defcustom org-attach-auto-tag "ATTACH"
|
|
|
"Tag that will be triggered automatically when an entry has an attachment."
|
|
@@ -81,15 +70,27 @@ This is only done if the Org file is in a git repository."
|
|
|
(const :tag "None" nil)
|
|
|
(string :tag "Tag")))
|
|
|
|
|
|
-(defcustom org-attach-file-list-property "Attachments"
|
|
|
- "The property used to keep a list of attachment belonging to this entry.
|
|
|
-This is not really needed, so you may set this to nil if you don't want it.
|
|
|
-Also, for entries where children inherit the directory, the list of
|
|
|
-attachments is not kept in this property."
|
|
|
+(defcustom org-attach-preferred-new-method 'id
|
|
|
+ "Preferred way to attach to nodes without existing ID and DIR property.
|
|
|
+This choice is used when adding attachments to nodes without ID
|
|
|
+and DIR properties.
|
|
|
+
|
|
|
+Allowed values are:
|
|
|
+
|
|
|
+id Create and use an ID parameter
|
|
|
+dir Create and use a DIR parameter
|
|
|
+ask Ask the user for input of which method to choose
|
|
|
+nil Prefer to not create a new parameter
|
|
|
+
|
|
|
+ nil means that ID or DIR has to be created explicitly
|
|
|
+ before attaching files."
|
|
|
:group 'org-attach
|
|
|
+ :package-version '(org . "9.3")
|
|
|
:type '(choice
|
|
|
- (const :tag "None" nil)
|
|
|
- (string :tag "Tag")))
|
|
|
+ (const :tag "ID parameter" id)
|
|
|
+ (const :tag "DIR parameter" dir)
|
|
|
+ (const :tag "Ask user" ask)
|
|
|
+ (const :tag "Don't create" nil)))
|
|
|
|
|
|
(defcustom org-attach-method 'cp
|
|
|
"The preferred method to attach a file.
|
|
@@ -113,14 +114,24 @@ lns create a symbol link. Note that this is not supported
|
|
|
:group 'org-attach
|
|
|
:type 'boolean)
|
|
|
|
|
|
-(defcustom org-attach-allow-inheritance t
|
|
|
- "Non-nil means allow attachment directories be inherited."
|
|
|
+(defcustom org-attach-use-inheritance 'selective
|
|
|
+ "Attachment inheritance for the outline.
|
|
|
+
|
|
|
+Enabling inheritance for org-attach implies two things. First,
|
|
|
+that attachment links will look through all parent headings until
|
|
|
+it finds the linked attachment. Second, that running org-attach
|
|
|
+inside a node without attachments will make org-attach operate on
|
|
|
+the first parent heading it finds with an attachment.
|
|
|
+
|
|
|
+Selective means to respect the inheritance setting in
|
|
|
+`org-use-property-inheritance'."
|
|
|
:group 'org-attach
|
|
|
+ :type '(choice
|
|
|
+ (const :tag "Don't use inheritance" nil)
|
|
|
+ (const :tag "Inherit parent node attachments" t)
|
|
|
+ (const :tag "Respect org-use-property-inheritance" selective))
|
|
|
:type 'boolean)
|
|
|
|
|
|
-(defvar org-attach-inherited nil
|
|
|
- "Indicates if the last access to the attachment directory was inherited.")
|
|
|
-
|
|
|
(defcustom org-attach-store-link-p nil
|
|
|
"Non-nil means store a link to a file when attaching it."
|
|
|
:group 'org-attach
|
|
@@ -141,16 +152,28 @@ When set to `query', ask the user instead."
|
|
|
(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."
|
|
|
+(defun org-attach-id-folder-format (id)
|
|
|
+ "Translate an ID into a folder-path.
|
|
|
+Default format for how Org translates ID properties to a path for
|
|
|
+attachments."
|
|
|
+ (format "%s/%s"
|
|
|
+ (substring id 0 2)
|
|
|
+ (substring id 2)))
|
|
|
+
|
|
|
+(defcustom org-attach-id-to-path-function #'org-attach-id-folder-format
|
|
|
+ "Function parsing the ID parameter into a folder-path."
|
|
|
: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)))
|
|
|
+ :package-version '(Org . "9.3")
|
|
|
+ :type 'function)
|
|
|
+
|
|
|
+(defvar org-attach-after-change-hook nil
|
|
|
+ "Hook to be called when files have been added or removed to the attachment folder.")
|
|
|
+
|
|
|
+(defvar org-attach-open-hook nil
|
|
|
+ "Hook that is invoked by `org-attach-open'.
|
|
|
+
|
|
|
+Created mostly to be compatible with org-attach-git after removing
|
|
|
+git-funtionality from this file.")
|
|
|
|
|
|
(defcustom org-attach-commands
|
|
|
'(((?a ?\C-a) org-attach-attach
|
|
@@ -186,9 +209,9 @@ you added attachments yourself.\n")
|
|
|
"Delete all of a task's attachments. A safer way is\n to open the \
|
|
|
directory in dired and delete from there.\n")
|
|
|
((?s ?\C-s) org-attach-set-directory
|
|
|
- "Set a specific attachment directory for this entry or reset to default.")
|
|
|
- ((?i ?\C-i) org-attach-set-inherit
|
|
|
- "Make children of the current entry inherit its attachment directory.\n")
|
|
|
+ "Set a specific attachment directory for this entry. Sets DIR property.")
|
|
|
+ ((?S ?\C-S) org-attach-unset-directory
|
|
|
+ "Unset the attachment directory for this entry. Removes DIR property.")
|
|
|
((?q) (lambda () (interactive) (message "Abort")) "Abort."))
|
|
|
"The list of commands for the attachment dispatcher.
|
|
|
Each entry in this list is a list of three elements:
|
|
@@ -215,7 +238,7 @@ Shows a list of commands and prompts for another key to execute a command."
|
|
|
(setq marker (or (get-text-property (point) 'org-hd-marker)
|
|
|
(get-text-property (point) 'org-marker)))
|
|
|
(unless marker
|
|
|
- (error "No task in current line")))
|
|
|
+ (error "No item in current line")))
|
|
|
(save-excursion
|
|
|
(when marker
|
|
|
(set-buffer (marker-buffer marker))
|
|
@@ -225,24 +248,28 @@ Shows a list of commands and prompts for another key to execute a command."
|
|
|
(save-window-excursion
|
|
|
(unless org-attach-expert
|
|
|
(with-output-to-temp-buffer "*Org Attach*"
|
|
|
- (princ
|
|
|
- (format "Select an Attachment Command:\n\n%s"
|
|
|
- (mapconcat
|
|
|
- (lambda (entry)
|
|
|
- (pcase entry
|
|
|
- (`((,key . ,_) ,_ ,docstring)
|
|
|
- (format "%c %s"
|
|
|
- key
|
|
|
- (replace-regexp-in-string "\n\\([\t ]*\\)"
|
|
|
- " "
|
|
|
- docstring
|
|
|
- nil nil 1)))
|
|
|
- (_
|
|
|
- (user-error
|
|
|
- "Invalid `org-attach-commands' item: %S"
|
|
|
- entry))))
|
|
|
- org-attach-commands
|
|
|
- "\n")))))
|
|
|
+ (princ
|
|
|
+ (concat "Attachment folder:\n"
|
|
|
+ (or (org-attach-dir)
|
|
|
+ "Can't find an existing attachment-folder")
|
|
|
+ "\n\n"
|
|
|
+ (format "Select an Attachment Command:\n\n%s"
|
|
|
+ (mapconcat
|
|
|
+ (lambda (entry)
|
|
|
+ (pcase entry
|
|
|
+ (`((,key . ,_) ,_ ,docstring)
|
|
|
+ (format "%c %s"
|
|
|
+ key
|
|
|
+ (replace-regexp-in-string "\n\\([\t ]*\\)"
|
|
|
+ " "
|
|
|
+ docstring
|
|
|
+ nil nil 1)))
|
|
|
+ (_
|
|
|
+ (user-error
|
|
|
+ "Invalid `org-attach-commands' item: %S"
|
|
|
+ entry))))
|
|
|
+ org-attach-commands
|
|
|
+ "\n"))))))
|
|
|
(org-fit-window-to-buffer (get-buffer-window "*Org Attach*"))
|
|
|
(message "Select command: [%s]"
|
|
|
(concat (mapcar #'caar org-attach-commands)))
|
|
@@ -256,148 +283,126 @@ Shows a list of commands and prompts for another key to execute a command."
|
|
|
(error "No such attachment command: %c" c))))))
|
|
|
|
|
|
(defun org-attach-dir (&optional create-if-not-exists-p)
|
|
|
- "Return the directory associated with the current entry.
|
|
|
-This first checks for a local property ATTACH_DIR, and then for an inherited
|
|
|
-property ATTACH_DIR_INHERIT. If neither exists, the default mechanism
|
|
|
-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)
|
|
|
- (setq org-attach-inherited (org-entry-get nil "ATTACH_DIR_INHERIT"))
|
|
|
+ "Return the directory associated with the current outline node.
|
|
|
+First check for DIR property, then ID property.
|
|
|
+`org-attach-use-inheritance' determines whether inherited
|
|
|
+properties also will be considered.
|
|
|
+
|
|
|
+If an ID property is found the default mechanism using that ID
|
|
|
+will be invoked to access the directory for the current entry.
|
|
|
+
|
|
|
+If CREATE-IF-NOT-EXIST-P is non-nil, `org-attach-dir-get-create'
|
|
|
+is run."
|
|
|
+ (let (attach-dir id)
|
|
|
(cond
|
|
|
- ((setq attach-dir (org-entry-get nil "ATTACH_DIR"))
|
|
|
+ (create-if-not-exists-p
|
|
|
+ (setq attach-dir (org-attach-dir-get-create)))
|
|
|
+ ((setq attach-dir (org-entry-get nil "DIR" org-attach-use-inheritance))
|
|
|
(org-attach-check-absolute-path attach-dir))
|
|
|
- ((and org-attach-allow-inheritance
|
|
|
- (org-entry-get nil "ATTACH_DIR_INHERIT" t))
|
|
|
- (setq attach-dir
|
|
|
- (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
|
|
|
+ ;; Deprecated and removed from documentation, but still
|
|
|
+ ;; works. FIXME: Remove after major nr change.
|
|
|
+ ((setq attach-dir (org-entry-get nil "ATTACH_DIR" org-attach-use-inheritance))
|
|
|
+ (org-attach-check-absolute-path attach-dir))
|
|
|
+ ((setq id (org-entry-get nil "ID" org-attach-use-inheritance))
|
|
|
(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)
|
|
|
- (unless uuid (error "ID retrieval/creation failed"))
|
|
|
- (setq attach-dir (expand-file-name
|
|
|
- (format "%s/%s"
|
|
|
- (substring uuid 0 2)
|
|
|
- (substring uuid 2))
|
|
|
- (expand-file-name org-attach-directory))))))
|
|
|
- (when attach-dir
|
|
|
- (if (and create-if-not-exists-p
|
|
|
- (not (file-directory-p attach-dir)))
|
|
|
- (make-directory attach-dir t))
|
|
|
- (and (file-exists-p attach-dir)
|
|
|
- attach-dir))))
|
|
|
+ (setq attach-dir (org-attach-dir-from-id id))))
|
|
|
+ attach-dir))
|
|
|
+
|
|
|
+(defun org-attach-dir-get-create ()
|
|
|
+ "Return existing or new directory associated with the current outline node.
|
|
|
+
|
|
|
+`org-attach-preferred-new-method' decides how to attach
|
|
|
+new directory."
|
|
|
+ (interactive)
|
|
|
+ (let ((attach-dir (org-attach-dir)))
|
|
|
+ (unless attach-dir
|
|
|
+ (let (answer)
|
|
|
+ (when (eq org-attach-preferred-new-method 'ask)
|
|
|
+ (message "Create new ID [1] property or DIR [2] property for attachments?")
|
|
|
+ (setq answer (read-char-exclusive)))
|
|
|
+ (cond
|
|
|
+ ((or (eq org-attach-preferred-new-method 'id) (eq answer ?1))
|
|
|
+ (setq attach-dir (org-attach-dir-from-id (org-id-get nil t))))
|
|
|
+ ((or (eq org-attach-preferred-new-method 'dir) (eq answer ?2))
|
|
|
+ (setq attach-dir (org-attach-set-directory)))
|
|
|
+ ((eq org-attach-preferred-new-method 'nil)
|
|
|
+ (error "No existing directory. DIR or ID property has to be explicitly created")))))
|
|
|
+ (unless attach-dir
|
|
|
+ (error "No attachment directory is associated with the current node"))
|
|
|
+ (unless (file-directory-p attach-dir)
|
|
|
+ (make-directory attach-dir t))
|
|
|
+ attach-dir))
|
|
|
+
|
|
|
+(defun org-attach-dir-from-id (id)
|
|
|
+ "Returns a file name based on `org-attach-id-dir' and ID."
|
|
|
+ (expand-file-name
|
|
|
+ (funcall org-attach-id-to-path-function id)
|
|
|
+ (expand-file-name org-attach-id-dir)))
|
|
|
|
|
|
(defun org-attach-check-absolute-path (dir)
|
|
|
"Check if we have enough information to root the attachment directory.
|
|
|
When DIR is given, check also if it is already absolute. Otherwise,
|
|
|
-assume that it will be relative, and check if `org-attach-directory' is
|
|
|
+assume that it will be relative, and check if `org-attach-id-dir' is
|
|
|
absolute, or if at least the current buffer has a file name.
|
|
|
Throw an error if we cannot root the directory."
|
|
|
(or (and dir (file-name-absolute-p dir))
|
|
|
- (file-name-absolute-p org-attach-directory)
|
|
|
+ (file-name-absolute-p org-attach-id-dir)
|
|
|
(buffer-file-name (buffer-base-buffer))
|
|
|
- (error "Need absolute `org-attach-directory' to attach in buffers without filename")))
|
|
|
+ (error "Need absolute `org-attach-id-dir' to attach in buffers without filename")))
|
|
|
|
|
|
-(defun org-attach-set-directory (&optional arg)
|
|
|
- "Set the ATTACH_DIR node property and ask to move files there.
|
|
|
+(defun org-attach-set-directory ()
|
|
|
+ "Set the DIR node property and ask to move files there.
|
|
|
The property defines the directory that is used for attachments
|
|
|
-of the entry. When called with `\\[universal-argument]', reset \
|
|
|
-the directory to
|
|
|
-the default ID based one."
|
|
|
- (interactive "P")
|
|
|
+of the entry. Creates relative links if `org-attach-dir-relative'
|
|
|
+is non-nil.
|
|
|
+
|
|
|
+Return the directory."
|
|
|
+ (interactive)
|
|
|
(let ((old (org-attach-dir))
|
|
|
- (new
|
|
|
- (progn
|
|
|
- (if arg (org-entry-delete nil "ATTACH_DIR")
|
|
|
- (let ((dir (read-directory-name
|
|
|
- "Attachment directory: "
|
|
|
- (org-entry-get nil
|
|
|
- "ATTACH_DIR"
|
|
|
- (and org-attach-allow-inheritance t)))))
|
|
|
- (org-entry-put nil "ATTACH_DIR" dir)))
|
|
|
- (org-attach-dir t))))
|
|
|
+ (new
|
|
|
+ (let* ((attach-dir (read-directory-name
|
|
|
+ "Attachment directory: "
|
|
|
+ (org-entry-get nil "DIR")))
|
|
|
+ (current-dir (file-name-directory (or default-directory
|
|
|
+ buffer-file-name)))
|
|
|
+ (attach-dir-relative (file-relative-name attach-dir current-dir)))
|
|
|
+ (org-entry-put nil "DIR" (if org-attach-dir-relative
|
|
|
+ attach-dir-relative
|
|
|
+ attach-dir))
|
|
|
+ attach-dir)))
|
|
|
(unless (or (string= old new)
|
|
|
(not old))
|
|
|
(when (yes-or-no-p "Copy over attachments from old directory? ")
|
|
|
+ (copy-directory old new t t t))
|
|
|
+ (when (yes-or-no-p (concat "Delete " old))
|
|
|
+ (delete-directory old t)))
|
|
|
+ new))
|
|
|
+
|
|
|
+(defun org-attach-unset-directory ()
|
|
|
+ "Removes DIR node property.
|
|
|
+If attachment folder is changed due to removal of DIR-property
|
|
|
+ask to move attachments to new location and ask to delete old
|
|
|
+attachment-folder.
|
|
|
+
|
|
|
+Change of attachment-folder due to unset might be if an ID
|
|
|
+property is set on the node, or if a separate inherited
|
|
|
+DIR-property exists (that is different than the unset one)."
|
|
|
+ (interactive)
|
|
|
+ (let ((old (org-attach-dir))
|
|
|
+ (new
|
|
|
+ (progn
|
|
|
+ (org-entry-delete nil "DIR")
|
|
|
+ ;; ATTACH-DIR is deprecated and removed from documentation,
|
|
|
+ ;; but still works. Remove code for it after major nr change.
|
|
|
+ (org-entry-delete nil "ATTACH_DIR")
|
|
|
+ (org-attach-dir))))
|
|
|
+ (unless (or (string= old new)
|
|
|
+ (not old))
|
|
|
+ (when (and new (yes-or-no-p "Copy over attachments from old directory? "))
|
|
|
(copy-directory old new t nil t))
|
|
|
(when (yes-or-no-p (concat "Delete " old))
|
|
|
(delete-directory old t)))))
|
|
|
|
|
|
-(defun org-attach-set-inherit ()
|
|
|
- "Set the ATTACH_DIR_INHERIT property of the current entry.
|
|
|
-The property defines the directory that is used for attachments
|
|
|
-of the entry and any children that do not explicitly define (by setting
|
|
|
-the ATTACH_DIR property) their own attachment directory."
|
|
|
- (interactive)
|
|
|
- (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* ((default-directory (expand-file-name org-attach-directory))
|
|
|
- (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)
|
|
|
- (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'"))))))
|
|
|
-
|
|
|
(defun org-attach-tag (&optional off)
|
|
|
"Turn the autotag on or (if OFF is set) off."
|
|
|
(when org-attach-auto-tag
|
|
@@ -423,22 +428,21 @@ Only do this when `org-attach-store-link-p' is non-nil."
|
|
|
(org-attach-attach url)))
|
|
|
|
|
|
(defun org-attach-buffer (buffer-name)
|
|
|
- "Attach BUFFER-NAME's contents to current task.
|
|
|
+ "Attach BUFFER-NAME's contents to current outline node.
|
|
|
BUFFER-NAME is a string. Signals a `file-already-exists' error
|
|
|
if it would overwrite an existing filename."
|
|
|
(interactive "bBuffer whose contents should be attached: ")
|
|
|
- (let ((output (expand-file-name buffer-name (org-attach-dir t))))
|
|
|
+ (let* ((attach-dir (org-attach-dir 'get-create))
|
|
|
+ (output (expand-file-name buffer-name attach-dir)))
|
|
|
(when (file-exists-p output)
|
|
|
(signal 'file-already-exists (list "File exists" output)))
|
|
|
- (when (and org-attach-file-list-property (not org-attach-inherited))
|
|
|
- (org-entry-add-to-multivalued-property
|
|
|
- (point) org-attach-file-list-property buffer-name))
|
|
|
+ (run-hook-with-args 'org-attach-after-change-hook attach-dir)
|
|
|
(org-attach-tag)
|
|
|
(with-temp-file output
|
|
|
(insert-buffer-substring buffer-name))))
|
|
|
|
|
|
(defun org-attach-attach (file &optional visit-dir method)
|
|
|
- "Move/copy/link FILE into the attachment directory of the current task.
|
|
|
+ "Move/copy/link FILE into the attachment directory of the current outline node.
|
|
|
If VISIT-DIR is non-nil, visit the directory with dired.
|
|
|
METHOD may be `cp', `mv', `ln', `lns' or `url' default taken from
|
|
|
`org-attach-method'."
|
|
@@ -453,10 +457,7 @@ METHOD may be `cp', `mv', `ln', `lns' or `url' default taken from
|
|
|
nil))
|
|
|
(setq method (or method org-attach-method))
|
|
|
(let ((basename (file-name-nondirectory file)))
|
|
|
- (when (and org-attach-file-list-property (not org-attach-inherited))
|
|
|
- (org-entry-add-to-multivalued-property
|
|
|
- (point) org-attach-file-list-property basename))
|
|
|
- (let* ((attach-dir (org-attach-dir t))
|
|
|
+ (let* ((attach-dir (org-attach-dir 'get-create))
|
|
|
(fname (expand-file-name basename attach-dir)))
|
|
|
(cond
|
|
|
((eq method 'mv) (rename-file file fname))
|
|
@@ -464,8 +465,7 @@ METHOD may be `cp', `mv', `ln', `lns' or `url' default taken from
|
|
|
((eq method 'ln) (add-name-to-file file fname))
|
|
|
((eq method 'lns) (make-symbolic-link file fname))
|
|
|
((eq method 'url) (url-copy-file file fname)))
|
|
|
- (when org-attach-commit
|
|
|
- (org-attach-commit))
|
|
|
+ (run-hook-with-args 'org-attach-after-change-hook attach-dir)
|
|
|
(org-attach-tag)
|
|
|
(cond ((eq org-attach-store-link-p 'attached)
|
|
|
(org-attach-store-link fname))
|
|
@@ -473,7 +473,7 @@ METHOD may be `cp', `mv', `ln', `lns' or `url' default taken from
|
|
|
(org-attach-store-link file)))
|
|
|
(if visit-dir
|
|
|
(dired attach-dir)
|
|
|
- (message "File %S is now a task attachment." basename)))))
|
|
|
+ (message "File %S is now an attachment." basename)))))
|
|
|
|
|
|
(defun org-attach-attach-cp ()
|
|
|
"Attach a file by copying it."
|
|
@@ -498,13 +498,10 @@ On some systems, this apparently does copy the file instead."
|
|
|
(let ((org-attach-method 'lns)) (call-interactively 'org-attach-attach)))
|
|
|
|
|
|
(defun org-attach-new (file)
|
|
|
- "Create a new attachment FILE for the current task.
|
|
|
+ "Create a new attachment FILE for the current outline node.
|
|
|
The attachment is created as an Emacs buffer."
|
|
|
(interactive "sCreate attachment named: ")
|
|
|
- (when (and org-attach-file-list-property (not org-attach-inherited))
|
|
|
- (org-entry-add-to-multivalued-property
|
|
|
- (point) org-attach-file-list-property file))
|
|
|
- (let ((attach-dir (org-attach-dir t)))
|
|
|
+ (let ((attach-dir (org-attach-dir 'get-create)))
|
|
|
(org-attach-tag)
|
|
|
(find-file (expand-file-name file attach-dir))
|
|
|
(message "New attachment %s" file)))
|
|
@@ -512,7 +509,7 @@ The attachment is created as an Emacs buffer."
|
|
|
(defun org-attach-delete-one (&optional file)
|
|
|
"Delete a single attachment."
|
|
|
(interactive)
|
|
|
- (let* ((attach-dir (org-attach-dir t))
|
|
|
+ (let* ((attach-dir (org-attach-dir))
|
|
|
(files (org-attach-file-list attach-dir))
|
|
|
(file (or file
|
|
|
(completing-read
|
|
@@ -524,44 +521,32 @@ The attachment is created as an Emacs buffer."
|
|
|
(unless (file-exists-p file)
|
|
|
(error "No such attachment: %s" file))
|
|
|
(delete-file file)
|
|
|
- (when org-attach-commit
|
|
|
- (org-attach-commit))))
|
|
|
+ (run-hook-with-args 'org-attach-after-change-hook attach-dir)))
|
|
|
|
|
|
(defun org-attach-delete-all (&optional force)
|
|
|
- "Delete all attachments from the current task.
|
|
|
+ "Delete all attachments from the current outline node.
|
|
|
This actually deletes the entire attachment directory.
|
|
|
A safer way is to open the directory in dired and delete from there."
|
|
|
(interactive "P")
|
|
|
- (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)))
|
|
|
- (when
|
|
|
- (and attach-dir
|
|
|
- (or force
|
|
|
- (y-or-n-p "Are you sure you want to remove all attachments of this entry? ")))
|
|
|
- (shell-command (format "rm -fr %s" attach-dir))
|
|
|
+ (when (and attach-dir
|
|
|
+ (or force
|
|
|
+ (yes-or-no-p "Really remove all attachments of this entry? ")))
|
|
|
+ (delete-directory attach-dir (yes-or-no-p "Recursive?") t)
|
|
|
(message "Attachment directory removed")
|
|
|
- (when org-attach-commit
|
|
|
- (org-attach-commit))
|
|
|
+ (run-hook-with-args 'org-attach-after-change-hook attach-dir)
|
|
|
(org-attach-untag))))
|
|
|
|
|
|
(defun org-attach-sync ()
|
|
|
- "Synchronize the current tasks with its attachments.
|
|
|
+ "Synchronize the current outline node with its attachments.
|
|
|
This can be used after files have been added externally."
|
|
|
(interactive)
|
|
|
- (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)))
|
|
|
(when attach-dir
|
|
|
+ (run-hook-with-args 'org-attach-after-change-hook attach-dir)
|
|
|
(let ((files (org-attach-file-list attach-dir)))
|
|
|
- (org-attach-tag (not files))
|
|
|
- (when org-attach-file-list-property
|
|
|
- (dolist (file files)
|
|
|
- (unless (string-match "^\\.\\.?\\'" file)
|
|
|
- (org-entry-add-to-multivalued-property
|
|
|
- (point) org-attach-file-list-property file))))))))
|
|
|
+ (org-attach-tag (not files))))
|
|
|
+ (unless attach-dir (org-attach-tag t))))
|
|
|
|
|
|
(defun org-attach-file-list (dir)
|
|
|
"Return a list of files in the attachment directory.
|
|
@@ -570,35 +555,40 @@ This ignores files ending in \"~\"."
|
|
|
(mapcar (lambda (x) (if (string-match "^\\.\\.?\\'" x) nil x))
|
|
|
(directory-files dir nil "[^~]\\'"))))
|
|
|
|
|
|
-(defun org-attach-reveal (&optional if-exists)
|
|
|
- "Show the attachment directory of the current task.
|
|
|
+(defun org-attach-reveal ()
|
|
|
+ "Show the attachment directory of the current outline node.
|
|
|
This will attempt to use an external program to show the directory."
|
|
|
- (interactive "P")
|
|
|
- (let ((attach-dir (org-attach-dir (not if-exists))))
|
|
|
- (and attach-dir (org-open-file attach-dir))))
|
|
|
+ (interactive)
|
|
|
+ (let ((attach-dir (org-attach-dir)))
|
|
|
+ (if attach-dir
|
|
|
+ (org-open-file attach-dir)
|
|
|
+ (error "No attachment directory exist"))))
|
|
|
|
|
|
(defun org-attach-reveal-in-emacs ()
|
|
|
- "Show the attachment directory of the current task in dired."
|
|
|
+ "Show the attachment directory of the current outline node in dired."
|
|
|
(interactive)
|
|
|
- (let ((attach-dir (org-attach-dir t)))
|
|
|
- (dired attach-dir)))
|
|
|
+ (let ((attach-dir (org-attach-dir)))
|
|
|
+ (if attach-dir
|
|
|
+ (dired attach-dir)
|
|
|
+ (error "No attachment directory exist"))))
|
|
|
|
|
|
(defun org-attach-open (&optional in-emacs)
|
|
|
- "Open an attachment of the current task.
|
|
|
+ "Open an attachment of the current outline node.
|
|
|
If there are more than one attachment, you will be prompted for the file name.
|
|
|
This command will open the file using the settings in `org-file-apps'
|
|
|
and in the system-specific variants of this variable.
|
|
|
If IN-EMACS is non-nil, force opening in Emacs."
|
|
|
(interactive "P")
|
|
|
- (let* ((attach-dir (org-attach-dir t))
|
|
|
- (files (org-attach-file-list attach-dir))
|
|
|
- (file (if (= (length files) 1)
|
|
|
- (car files)
|
|
|
- (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)))
|
|
|
+ (let ((attach-dir (org-attach-dir)))
|
|
|
+ (if attach-dir
|
|
|
+ (let* ((file (pcase (org-attach-file-list attach-dir)
|
|
|
+ (`(,file) file)
|
|
|
+ (files (completing-read "Open attachment: "
|
|
|
+ (mapcar #'list files) nil t))))
|
|
|
+ (path (expand-file-name file attach-dir)))
|
|
|
+ (run-hook-with-args 'org-attach-open-hook path)
|
|
|
+ (org-open-file path in-emacs))
|
|
|
+ (error "No attachment directory exist"))))
|
|
|
|
|
|
(defun org-attach-open-in-emacs ()
|
|
|
"Open attachment, force opening in Emacs.
|
|
@@ -617,6 +607,69 @@ Basically, this adds the path to the attachment directory, and a \"file:\"
|
|
|
prefix."
|
|
|
(concat "file:" (org-attach-expand file)))
|
|
|
|
|
|
+(org-link-set-parameters "attachment"
|
|
|
+ :follow #'org-attach-open-link
|
|
|
+ :export #'org-attach-export-link
|
|
|
+ :complete #'org-attach-complete-link)
|
|
|
+
|
|
|
+(defun org-attach-open-link (link &optional in-emacs)
|
|
|
+ "Attachment link type LINK is expanded with the attached directory and opened.
|
|
|
+
|
|
|
+With optional prefix argument IN-EMACS, Emacs will visit the file.
|
|
|
+With a double \\[universal-argument] \\[universal-argument] \
|
|
|
+prefix arg, Org tries to avoid opening in Emacs
|
|
|
+and to use an external application to visit the file."
|
|
|
+ (interactive "P")
|
|
|
+ (let (line search)
|
|
|
+ (cond
|
|
|
+ ((string-match "::\\([0-9]+\\)\\'" link)
|
|
|
+ (setq line (string-to-number (match-string 1 link))
|
|
|
+ link (substring link 0 (match-beginning 0))))
|
|
|
+ ((string-match "::\\(.+\\)\\'" link)
|
|
|
+ (setq search (match-string 1 link)
|
|
|
+ link (substring link 0 (match-beginning 0)))))
|
|
|
+ (if (string-match "[*?{]" (file-name-nondirectory link))
|
|
|
+ (dired (org-attach-expand link))
|
|
|
+ (org-open-file (org-attach-expand link) in-emacs line search))))
|
|
|
+
|
|
|
+(defun org-attach-complete-link ()
|
|
|
+ "Advise the user with the available files in the attachment directory."
|
|
|
+ (let ((attach-dir (org-attach-dir)))
|
|
|
+ (if attach-dir
|
|
|
+ (let* ((attached-dir (expand-file-name attach-dir))
|
|
|
+ (file (read-file-name "File: " attached-dir))
|
|
|
+ (pwd (file-name-as-directory attached-dir))
|
|
|
+ (pwd-relative (file-name-as-directory
|
|
|
+ (abbreviate-file-name attached-dir))))
|
|
|
+ (cond
|
|
|
+ ((string-match (concat "^" (regexp-quote pwd-relative) "\\(.+\\)") file)
|
|
|
+ (concat "attachment:" (match-string 1 file)))
|
|
|
+ ((string-match (concat "^" (regexp-quote pwd) "\\(.+\\)")
|
|
|
+ (expand-file-name file))
|
|
|
+ (concat "attachment:" (match-string 1 (expand-file-name file))))
|
|
|
+ (t (concat "attachment:" file))))
|
|
|
+ (error "No attachment directory exist"))))
|
|
|
+
|
|
|
+(defun org-attach-export-link (link description format)
|
|
|
+ "Translate attachment LINK from Org mode format to exported FORMAT.
|
|
|
+Also includes the DESCRIPTION of the link in the export."
|
|
|
+ (save-excursion
|
|
|
+ (let (path desc)
|
|
|
+ (cond
|
|
|
+ ((string-match "::\\([0-9]+\\)\\'" link)
|
|
|
+ (setq link (substring link 0 (match-beginning 0))))
|
|
|
+ ((string-match "::\\(.+\\)\\'" link)
|
|
|
+ (setq link (substring link 0 (match-beginning 0)))))
|
|
|
+ (setq path (file-relative-name (org-attach-expand link))
|
|
|
+ desc (or description link))
|
|
|
+ (pcase format
|
|
|
+ (`html (format "<a target=\"_blank\" href=\"%s\">%s</a>" path desc))
|
|
|
+ (`latex (format "\\href{%s}{%s}" path desc))
|
|
|
+ (`texinfo (format "@uref{%s,%s}" path desc))
|
|
|
+ (`ascii (format "%s (%s)" desc path))
|
|
|
+ (`md (format "[%s](%s)" desc path))
|
|
|
+ (_ path)))))
|
|
|
+
|
|
|
(defun org-attach-archive-delete-maybe ()
|
|
|
"Maybe delete subtree attachments when archiving.
|
|
|
This function is called by `org-archive-hook'. The option
|
|
@@ -644,7 +697,7 @@ Idea taken from `gnus-dired-attach'."
|
|
|
(interactive
|
|
|
(list (dired-get-marked-files)))
|
|
|
(unless (eq major-mode 'dired-mode)
|
|
|
- (user-error "This command must be triggered in a dired buffer."))
|
|
|
+ (user-error "This command must be triggered in a dired buffer"))
|
|
|
(let ((start-win (selected-window))
|
|
|
(other-win
|
|
|
(get-window-with-predicate
|