From 3f4a0d5370ae6c34afe180df96add3b8522f4af1 Mon Sep 17 00:00:00 2001 From: mattkae Date: Wed, 11 May 2022 09:23:58 -0400 Subject: initial commit --- elpa/org-9.5.2/org-attach.el | 787 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 787 insertions(+) create mode 100644 elpa/org-9.5.2/org-attach.el (limited to 'elpa/org-9.5.2/org-attach.el') diff --git a/elpa/org-9.5.2/org-attach.el b/elpa/org-9.5.2/org-attach.el new file mode 100644 index 0000000..75db69c --- /dev/null +++ b/elpa/org-9.5.2/org-attach.el @@ -0,0 +1,787 @@ +;;; org-attach.el --- Manage file attachments to Org outlines -*- lexical-binding: t; -*- + +;; Copyright (C) 2008-2021 Free Software Foundation, Inc. + +;; Author: John Wiegley +;; Keywords: org data attachment +;; This file is part of GNU Emacs. +;; +;; GNU Emacs 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. + +;; GNU Emacs 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 GNU Emacs. If not, see . + +;;; Commentary: + +;; See the Org manual for information on how to use it. +;; +;; 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) + +(declare-function dired-dwim-target-directory "dired-aux") +(declare-function dired-get-marked-files "dired" (&optional localp arg filter distinguish-one-marked error)) +(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-type "org-element" (element)) +(declare-function org-inlinetask-goto-beginning "org-inlinetask" ()) +(declare-function org-inlinetask-in-task-p "org-inlinetask" ()) + +(defgroup org-attach nil + "Options concerning attachments in Org mode." + :tag "Org Attach" + :group 'org) + +(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." + :group 'org-attach + :type 'directory + :safe #'stringp) + +(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 + :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." + :group 'org-attach + :type '(choice + (const :tag "None" nil) + (string :tag "Tag"))) + +(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 "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. +Allowed values are: + +mv rename the file to move it into the attachment directory +cp copy the file +ln create a hard link. Note that this is not supported + on all systems, and then the result is not defined. +lns create a symbol link. Note that this is not supported + on all systems, and then the result is not defined." + :group 'org-attach + :type '(choice + (const :tag "Copy" cp) + (const :tag "Move/Rename" mv) + (const :tag "Hard Link" ln) + (const :tag "Symbol Link" lns))) + +(defcustom org-attach-expert nil + "Non-nil means do not show the splash buffer with the attach dispatcher." + :group 'org-attach + :type 'boolean) + +(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))) + +(defcustom org-attach-store-link-p nil + "Non-nil means store a link to a file when attaching it." + :group 'org-attach + :version "24.1" + :type '(choice + (const :tag "Don't store link" nil) + (const :tag "Link to origin location" t) + (const :tag "Attachment link to the attach-dir location" attached) + (const :tag "File link to the attach-dir location" file))) + +(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))) + +(defun org-attach-id-uuid-folder-format (id) + "Translate an UUID ID into a folder-path. +Default format for how Org translates ID properties to a path for +attachments. Useful if ID is generated with UUID." + (format "%s/%s" + (substring id 0 2) + (substring id 2))) + +(defun org-attach-id-ts-folder-format (id) + "Translate an ID based on a timestamp to a folder-path. +Useful way of translation if ID is generated based on ISO8601 +timestamp. Splits the attachment folder hierarchy into +year-month, the rest." + (format "%s/%s" + (substring id 0 6) + (substring id 6))) + +(defcustom org-attach-id-to-path-function-list '(org-attach-id-uuid-folder-format + org-attach-id-ts-folder-format) + "List of functions parsing an ID string into a folder-path. +The first function in this list defines the preferred function +which will be used when creating new attachment folders. All +functions of this list will be tried when looking for existing +attachment folders based on ID." + :group 'org-attach + :package-version '(Org . "9.3") + :type '(repeat (function :tag "Function with ID as input"))) + +(defvar org-attach-after-change-hook nil + "Hook 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-functionality from this file.") + +(defcustom org-attach-commands + '(((?a ?\C-a) org-attach-attach + "Select a file and attach it to the task, using `org-attach-method'.") + ((?c ?\C-c) org-attach-attach-cp + "Attach a file using copy method.") + ((?m ?\C-m) org-attach-attach-mv + "Attach a file using move method.") + ((?l ?\C-l) org-attach-attach-ln + "Attach a file using link method.") + ((?y ?\C-y) org-attach-attach-lns + "Attach a file using symbolic-link method.") + ((?u ?\C-u) org-attach-url + "Attach a file from URL (downloading it).") + ((?b) org-attach-buffer + "Select a buffer and attach its contents to the task.") + ((?n ?\C-n) org-attach-new + "Create a new attachment, as an Emacs buffer.") + ((?z ?\C-z) org-attach-sync + "Synchronize the current node with its attachment\n directory, in case \ +you added attachments yourself.\n") + ((?o ?\C-o) org-attach-open + "Open current node's attachments.") + ((?O) org-attach-open-in-emacs + "Like \"o\", but force opening in Emacs.") + ((?f ?\C-f) org-attach-reveal + "Open current node's attachment directory. Create if missing.") + ((?F) org-attach-reveal-in-emacs + "Like \"f\", but force using Dired in Emacs.\n") + ((?d ?\C-d) org-attach-delete-one + "Delete one attachment, you will be prompted for a file name.") + ((?D) org-attach-delete-all + "Delete all of a node'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. 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: +- A list of keys (characters) to select the command (the fist + character in the list is shown in the attachment dispatcher's + splash buffer and minibuffer prompt). +- A command that is called interactively when one of these keys + is pressed. +- A docstring for this command in the attachment dispatcher's + splash buffer." + :group 'org-attach + :package-version '(Org . "9.3") + :type '(repeat (list (repeat :tag "Keys" character) + (function :tag "Command") + (string :tag "Docstring")))) + +(defcustom org-attach-sync-delete-empty-dir 'query + "Determine what to do with an empty attachment directory on sync. +When set to nil, don't touch the directory. When set to `query', +ask the user instead, else remove without asking." + :group 'org-attach + :package-version '(Org . "9.5") + :type '(choice + (const :tag "Never delete" nil) + (const :tag "Always delete" t) + (const :tag "Query the user" query))) + +;;;###autoload +(defun org-attach () + "The dispatcher for attachment commands. +Shows a list of commands and prompts for another key to execute a command." + (interactive) + (let ((dir (org-attach-dir nil 'no-fs-check)) + c marker) + (when (eq major-mode 'org-agenda-mode) + (setq marker (or (get-text-property (point) 'org-hd-marker) + (get-text-property (point) 'org-marker))) + (unless marker + (error "No item in current line"))) + (org-with-point-at marker + (if (and (featurep 'org-inlinetask) + (not (org-inlinetask-in-task-p))) + (org-with-limited-levels + (org-back-to-heading-or-point-min t)) + (if (and (featurep 'org-inlinetask) + (org-inlinetask-in-task-p)) + (org-inlinetask-goto-beginning) + (org-back-to-heading-or-point-min t))) + (save-excursion + (save-window-excursion + (unless org-attach-expert + (org-switch-to-buffer-other-window "*Org Attach*") + (erase-buffer) + (setq cursor-type nil + header-line-format "Use C-v, M-v, C-n or C-p to navigate.") + (insert + (concat "Attachment folder:\n" + (or dir + "Can't find an existing attachment-folder") + (unless (and dir (file-directory-p dir)) + "\n(Not yet created)") + "\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*")) + (let ((msg (format "Select command: [%s]" + (concat (mapcar #'caar org-attach-commands))))) + (message msg) + (while (and (setq c (read-char-exclusive)) + (memq c '(14 16 22 134217846))) + (org-scroll c t))) + (and (get-buffer "*Org Attach*") (kill-buffer "*Org Attach*")))) + (let ((command (cl-some (lambda (entry) + (and (memq c (nth 0 entry)) (nth 1 entry))) + org-attach-commands))) + (if (commandp command t) + (call-interactively command) + (error "No such attachment command: %c" c)))))) + +(defun org-attach-dir (&optional create-if-not-exists-p no-fs-check) + "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. +Note that this method returns the directory as declared by ID or +DIR even if the directory doesn't exist in the filesystem. + +If CREATE-IF-NOT-EXIST-P is non-nil, `org-attach-dir-get-create' +is run. If NO-FS-CHECK is non-nil, the function returns the path +to the attachment even if it has not yet been initialized in the +filesystem. + +If no attachment directory can be derived, return nil." + (let (attach-dir id) + (cond + (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)) + ;; 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 attach-dir (org-attach-dir-from-id id 'try-all)))) + (if no-fs-check + attach-dir + (when (and attach-dir (file-directory-p attach-dir)) + 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 if neither ID nor DIR property exist. + +If the attachment by some reason cannot be created an error will be raised." + (interactive) + (let ((attach-dir (org-attach-dir nil 'no-fs-check))) + (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 &optional try-all) + "Return a folder path based on `org-attach-id-dir' and ID. +If TRY-ALL is non-nil, try all id-to-path functions in +`org-attach-id-to-path-function-list' and return the first path +that exist in the filesystem, or the first one if none exist. +Otherwise only use the first function in that list." + (let ((attach-dir-preferred (expand-file-name + (funcall (car org-attach-id-to-path-function-list) id) + (expand-file-name org-attach-id-dir)))) + (if try-all + (let ((attach-dir attach-dir-preferred) + (fun-list (cdr org-attach-id-to-path-function-list))) + (while (and fun-list (not (file-directory-p attach-dir))) + (setq attach-dir (expand-file-name + (funcall (car fun-list) id) + (expand-file-name org-attach-id-dir))) + (setq fun-list (cdr fun-list))) + (if (file-directory-p attach-dir) + attach-dir + attach-dir-preferred)) + attach-dir-preferred))) + +(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-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-id-dir) + (buffer-file-name (buffer-base-buffer)) + (error "Need absolute `org-attach-id-dir' to attach in buffers without filename"))) + +(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. Creates relative links if `org-attach-dir-relative' +is non-nil. + +Return the directory." + (interactive) + (let ((old (org-attach-dir)) + (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 () + "Remove 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 from 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-tag (&optional off) + "Turn the autotag on or (if OFF is set) off." + (when org-attach-auto-tag + (save-excursion + (org-back-to-heading t) + (org-toggle-tag org-attach-auto-tag (if off 'off 'on))))) + +(defun org-attach-untag () + "Turn the autotag off." + (org-attach-tag 'off)) + +(defun org-attach-url (url) + (interactive "MURL of the file to attach: \n") + (let ((org-attach-method 'url)) + (org-attach-attach url))) + +(defun org-attach-buffer (buffer-name) + "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* ((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))) + (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 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'." + (interactive + (list + (read-file-name "File to keep as an attachment: " + (or (progn + (require 'dired-aux) + (dired-dwim-target-directory)) + default-directory)) + current-prefix-arg + nil)) + (setq method (or method org-attach-method)) + (let ((basename (file-name-nondirectory file))) + (let* ((attach-dir (org-attach-dir 'get-create)) + (attach-file (expand-file-name basename attach-dir))) + (cond + ((eq method 'mv) (rename-file file attach-file)) + ((eq method 'cp) (copy-file file attach-file)) + ((eq method 'ln) (add-name-to-file file attach-file)) + ((eq method 'lns) (make-symbolic-link file attach-file)) + ((eq method 'url) (url-copy-file file attach-file))) + (run-hook-with-args 'org-attach-after-change-hook attach-dir) + (org-attach-tag) + (cond ((eq org-attach-store-link-p 'attached) + (push (list (concat "attachment:" (file-name-nondirectory attach-file)) + (file-name-nondirectory attach-file)) + org-stored-links)) + ((eq org-attach-store-link-p t) + (push (list (concat "file:" file) + (file-name-nondirectory file)) + org-stored-links)) + ((eq org-attach-store-link-p 'file) + (push (list (concat "file:" attach-file) + (file-name-nondirectory attach-file)) + org-stored-links))) + (if visit-dir + (dired attach-dir) + (message "File %S is now an attachment" basename))))) + +(defun org-attach-attach-cp () + "Attach a file by copying it." + (interactive) + (let ((org-attach-method 'cp)) (call-interactively 'org-attach-attach))) +(defun org-attach-attach-mv () + "Attach a file by moving (renaming) it." + (interactive) + (let ((org-attach-method 'mv)) (call-interactively 'org-attach-attach))) +(defun org-attach-attach-ln () + "Attach a file by creating a hard link to it. +Beware that this does not work on systems that do not support hard links. +On some systems, this apparently does copy the file instead." + (interactive) + (let ((org-attach-method 'ln)) (call-interactively 'org-attach-attach))) +(defun org-attach-attach-lns () + "Attach a file by creating a symbolic link to it. + +Beware that this does not work on systems that do not support symbolic links. +On some systems, this apparently does copy the file instead." + (interactive) + (let ((org-attach-method 'lns)) (call-interactively 'org-attach-attach))) + +(defun org-attach-new (file) + "Create a new attachment FILE for the current outline node. +The attachment is created as an Emacs buffer." + (interactive "sCreate attachment named: ") + (let ((attach-dir (org-attach-dir 'get-create))) + (org-attach-tag) + (find-file (expand-file-name file attach-dir)) + (message "New attachment %s" file))) + +(defun org-attach-delete-one (&optional file) + "Delete a single attachment." + (interactive) + (let* ((attach-dir (org-attach-dir)) + (files (org-attach-file-list attach-dir)) + (file (or file + (completing-read + "Delete attachment: " + (mapcar (lambda (f) + (list (file-name-nondirectory f))) + files))))) + (setq file (expand-file-name file attach-dir)) + (unless (file-exists-p file) + (error "No such attachment: %s" file)) + (delete-file file) + (run-hook-with-args 'org-attach-after-change-hook attach-dir))) + +(defun org-attach-delete-all (&optional force) + "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. + +With prefix argument FORCE, directory will be recursively deleted +with no prompts." + (interactive "P") + (let ((attach-dir (org-attach-dir))) + (when (and attach-dir + (or force + (yes-or-no-p "Really remove all attachments of this entry? "))) + (delete-directory attach-dir + (or force (yes-or-no-p "Recursive?")) + t) + (message "Attachment directory removed") + (run-hook-with-args 'org-attach-after-change-hook attach-dir) + (org-attach-untag)))) + +(defun org-attach-sync () + "Synchronize the current outline node with its attachments. +Useful after files have been added/removed externally. Option +`org-attach-sync-delete-empty-dir' controls the behavior for +empty attachment directories." + (interactive) + (let ((attach-dir (org-attach-dir))) + (if (not attach-dir) + (org-attach-tag 'off) + (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-sync-delete-empty-dir + (when (and (org-directory-empty-p attach-dir) + (if (eq 'query org-attach-sync-delete-empty-dir) + (yes-or-no-p "Attachment directory is empty. Delete?") + t)) + (delete-directory attach-dir)))))) + +(defun org-attach-file-list (dir) + "Return a list of files in the attachment directory. +This ignores files ending in \"~\"." + (delq nil + (mapcar (lambda (x) (if (string-match "^\\.\\.?\\'" x) nil x)) + (directory-files dir nil "[^~]\\'")))) + +(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. Will create an attachment and folder if it doesn't +exist yet. Respects `org-attach-preferred-new-method'." + (interactive) + (org-open-file (org-attach-dir-get-create))) + +(defun org-attach-reveal-in-emacs () + "Show the attachment directory of the current outline node in dired. +Will create an attachment and folder if it doesn't exist yet. +Respects `org-attach-preferred-new-method'." + (interactive) + (dired (org-attach-dir-get-create))) + +(defun org-attach-open (&optional in-emacs) + "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))) + (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. +See `org-attach-open'." + (interactive) + (org-attach-open 'in-emacs)) + +(defun org-attach-expand (file) + "Return the full path to the current entry's attachment file FILE. +Basically, this adds the path to the attachment directory." + (expand-file-name file (org-attach-dir))) + +(defun org-attach-expand-links (_) + "Expand links in current buffer. +It is meant to be added to `org-export-before-parsing-hook'." + (save-excursion + (while (re-search-forward "attachment:" nil t) + (let ((link (org-element-context))) + (when (and (eq 'link (org-element-type link)) + (string-equal "attachment" + (org-element-property :type link))) + (let* ((description (and (org-element-property :contents-begin link) + (buffer-substring-no-properties + (org-element-property :contents-begin link) + (org-element-property :contents-end link)))) + (file (org-element-property :path link)) + (new-link (org-link-make-string + (concat "file:" (org-attach-expand file)) + description))) + (goto-char (org-element-property :end link)) + (skip-chars-backward " \t") + (delete-region (org-element-property :begin link) (point)) + (insert new-link))))))) + +(defun org-attach-follow (file arg) + "Open FILE attachment. +See `org-open-file' for details about ARG." + (org-link-open-as-file (org-attach-expand file) arg)) + +(org-link-set-parameters "attachment" + :follow #'org-attach-follow + :complete #'org-attach-complete-link) + +(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-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 org-attach-archive-delete + (org-attach-delete-all (not (eq org-attach-archive-delete 'query))))) + + +;; Attach from dired. + +;; Add the following lines to the config file to get a binding for +;; dired-mode. + +;; (add-hook +;; 'dired-mode-hook +;; (lambda () +;; (define-key dired-mode-map (kbd "C-c C-x a") #'org-attach-dired-to-subtree)))) + +;;;###autoload +(defun org-attach-dired-to-subtree (files) + "Attach FILES marked or current file in dired to subtree in other window. +Takes the method given in `org-attach-method' for the attach action. +Precondition: Point must be in a dired buffer. +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")) + (let ((start-win (selected-window)) + (other-win + (get-window-with-predicate + (lambda (window) + (with-current-buffer (window-buffer window) + (eq major-mode 'org-mode)))))) + (unless other-win + (user-error + "Can't attach to subtree. No window displaying an Org buffer")) + (select-window other-win) + (dolist (file files) + (org-attach-attach file)) + (select-window start-win) + (when (eq 'mv org-attach-method) + (revert-buffer)))) + + + +(add-hook 'org-archive-hook 'org-attach-archive-delete-maybe) +(add-hook 'org-export-before-parsing-hook 'org-attach-expand-links) + +(provide 'org-attach) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; org-attach.el ends here -- cgit v1.2.1