From f556e3e1dcfff6103e54aee244bbeacf13aeeb55 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Gustav=20Wikstr=C3=B6m?= <gustav.erik@gmail.com>
Date: Sun, 23 Sep 2018 02:43:16 +0200
Subject: [PATCH] org-attach, org-manual, org: New link-type, more attach
 options

* Add new linktype "attached" for attachments

A new linktype "attached" is added in order to reduce link-duplication
when wanting to link to files in attached folders of nodes. This works
for both ID-based attachments and ATTACH_DIR.  Inline images will
trigger also for attachments, as well as search-decorations in the
links.  The goal is to make the functionality for attached-links
mirror file-links.

* Add further options for ATTACH_DIR

When working with ATTACH_DIR there are now a couple of new options available:
- org-attach-dir-inherit-by-default
- org-attach-dir-create-if-not-exist
- org-attach-dir-relative

Descriptions of them can be found in the commit for each new customization.

* Documentation in org-manual

Org-manual is updated with the new link-type as well as some minor
cleanup in the documentation related to external links and attachments.
---
 doc/org-manual.org |  72 ++++++++++++++++-------
 lisp/org-attach.el | 143 ++++++++++++++++++++++++++++++++++++---------
 lisp/org.el        |  17 ++++--
 3 files changed, 181 insertions(+), 51 deletions(-)

diff --git a/doc/org-manual.org b/doc/org-manual.org
index 5e4effb6f..960292ab2 100644
--- a/doc/org-manual.org
+++ b/doc/org-manual.org
@@ -3141,6 +3141,7 @@ point on or at a target.
 #+cindex: irc links
 #+cindex: URL links
 #+cindex: file links
+#+cindex: @ links
 #+cindex: Rmail links
 #+cindex: MH-E links
 #+cindex: Usenet links
@@ -3152,7 +3153,30 @@ Org supports links to files, websites, Usenet and email messages, BBDB
 database entries and links to both IRC conversations and their logs.
 External links are URL-like locators.  They start with a short
 identifying string followed by a colon.  There can be no space after
-the colon.  The following list shows examples for each link type.
+the colon.
+
+This list shows the full set of built-in external link types:
+| http       | web                                 |
+| https      | secure web                          |
+| doi        | DOI for electronic resources        |
+| file       | file-links                          |
+| file+sys   | file-links forced to open via OS    |
+| file+emacs | file-links forced to open via emacs |
+| @          | links to attachments for nodes      |
+| docview    | doc-view mode                       |
+| id         | Link to heading by id               |
+| news       | Usenet link                         |
+| mailto     | mail link                           |
+| mhe        | MH-E folder link                    |
+| rmail      | Rmail link                          |
+| gnus       | Gnus link                           |
+| bbdb       | BBDB link                           |
+| irc        | IRC link                            |
+| info       | Info link                           |
+| shell      | shell command                       |
+| elisp      | interactive elisp command link      |
+
+The following list shows examples for each link type.
 
 | =http://www.astro.uva.nl/=dominik=        | on the web                     |
 | =doi:10.1000/182=                         | DOI for an electronic resource |
@@ -3168,6 +3192,8 @@ the colon.  The following list shows examples for each link type.
 | =file:projects.org::*task title=          | heading search in Org file     |
 | =file+sys:/path/to/file=                  | open via OS, like double-click |
 | =file+emacs:/path/to/file=                | force opening by Emacs         |
+| =@:projects.org=                          | file attached to headline      |
+| =@:projects.org::some words=              | text search in attached file   |
 | =docview:papers/last.pdf::NNN=            | open in doc-view mode at page  |
 | =id:B7423F4D-2E8A-471B-8810-C40F074717E9= | link to heading by ID          |
 | =news:comp.emacs=                         | Usenet link                    |
@@ -3538,14 +3564,15 @@ the link completion function like this:
 :END:
 #+cindex: search option in file links
 #+cindex: file links, searching
+#+cindex: @ links, searching
 
-File links can contain additional information to make Emacs jump to
-a particular location in the file when following a link.  This can be
-a line number or a search option after a double colon[fn:35].  For
-example, when the command ~org-store-link~ creates a link (see
-[[*Handling Links]]) to a file, it encodes the words in the current line
-as a search string that can be used to find this line back later when
-following the link with {{{kbd(C-c C-o)}}}.
+File links and attached (@) links can contain additional information
+to make Emacs jump to a particular location in the file when following
+a link.  This can be a line number or a search option after a double
+colon[fn:35].  For example, when the command ~org-store-link~ creates
+a link (see [[*Handling Links]]) to a file, it encodes the words in the
+current line as a search string that can be used to find this line
+back later when following the link with {{{kbd(C-c C-o)}}}.
 
 Here is the syntax of the different ways to attach a search to a file
 link, together with explanations for each:
@@ -3556,6 +3583,7 @@ link, together with explanations for each:
 [[file:~/xx.org::*My Target]]
 [[file:~/xx.org::#my-custom-id]]
 [[file:~/xx.org::/regexp/]]
+[[@:~/code/main.c::255]]
 #+end_example
 
 - =255= ::
@@ -7533,18 +7561,22 @@ node/task.  Small chunks of plain text can simply be stored in the
 subtree of a project.  Hyperlinks (see [[*Hyperlinks]]) can establish
 associations with files that live elsewhere on your computer or in the
 cloud, like emails or source code files belonging to a project.
-Another method is /attachments/, which are files located in
-a directory belonging to an outline node.  Org uses directories named
-by the unique ID of each entry.  These directories are located in the
-~data~ directory which lives in the same directory where your Org file
-lives[fn:86].  If you initialize this directory with =git init=, Org
-automatically commits changes when it sees them.  The attachment
-system has been contributed to Org by John Wiegley.
-
-In cases where it seems better to do so, you can attach a directory of
-your choice to an entry.  You can also make children inherit the
-attachment directory from a parent, so that an entire subtree uses the
-same attached directory.
+Another method is /attachments/, which are files located in a
+directory belonging to an outline node.  Org uses directories either
+named by the unique ID of each entry, or by the =ATTACH_DIR= property.
+ID-based directories are by default located in the =data/= directory,
+which lives in the same directory where your Org file lives[fn:86].
+If you initialize this directory with =git init=, Org automatically
+commits changes when it sees them.  The attachment system has been
+contributed to Org by John Wiegley.
+
+In cases where =ATTACH_DIR= property is used to declare attachments,
+you can choose to either use absolute (default) or relative links.
+You can also make children inherit the attachment directory from a
+parent, so that an entire subtree uses the same attached directory.
+
+See customization group =Org Attach= if you want to change the default
+settings for attachments.
 
 The following commands deal with attachments:
 
diff --git a/lisp/org-attach.el b/lisp/org-attach.el
index e827d3721..bc7f02669 100644
--- a/lisp/org-attach.el
+++ b/lisp/org-attach.el
@@ -57,6 +57,30 @@ where the Org file lives."
   :type 'directory
   :safe #'stringp)
 
+(defcustom org-attach-dir-inherit-by-default nil
+  "Defines whether ATTACH_DIR-directories should be inherited by subheadings by default when created.
+Defaults to not being inherited."
+  :group 'org-attach
+  :type 'boolean
+  :package-version '(Org . "9.2")
+  :safe #'booleanp)
+
+(defcustom org-attach-dir-create-if-not-exists t
+  "Choose whether ATTACH_DIR-directories should be created if they do not exist since before.
+Default is to create them."
+  :group 'org-attach
+  :type 'boolean
+  :package-version '(Org . "9.2")
+  :safe #'booleanp)
+
+(defcustom org-attach-dir-relative nil
+  "Choose whether ATTACH_DIR-directories should be added as relative links or not.
+Defaults to not relative."
+  :group 'org-attach
+  :type 'boolean
+  :package-version '(Org . "9.2")
+  :safe #'booleanp)
+
 (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."
@@ -280,20 +304,26 @@ Throw an error if we cannot root the directory."
   "Set the ATTACH_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."
+the directory to the default ID based one.  Creates relative
+links if ORG-ATTACH-DIR-RELATIVE is t, and sets inheritance based
+on ORG-ATTACH-DIR-INHERIT-BY-DEFAULT."
   (interactive "P")
-  (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))))
+  (let ((old (org-attach-dir nil))
+	(new
+	 (progn
+	   (if arg (org-entry-delete nil "ATTACH_DIR")
+	     (let* ((attach-dir (read-directory-name
+				 "Attachment directory: "
+				 (org-entry-get nil
+						"ATTACH_DIR")))
+		    (current-dir (file-name-directory (or default-directory
+							  buffer-file-name)))
+		    (attach-dir-relative (file-relative-name attach-dir current-dir)))
+	       (if org-attach-dir-relative
+		   (org-entry-put nil "ATTACH_DIR" attach-dir-relative)
+		 (org-entry-put nil "ATTACH_DIR" attach-dir))))
+	   (org-attach-dir t))))
+    (when org-attach-dir-inherit-by-default (org-attach-set-inherit))
     (unless (or (string= old new)
                 (not old))
       (when (yes-or-no-p "Copy over attachments from old directory? ")
@@ -527,14 +557,15 @@ This ignores files ending in \"~\"."
   "Show the attachment directory of the current task.
 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))))
+  (let* ((create-if-not-exist (if if-exists nil org-attach-dir-create-if-not-exists))
+	 (attach-dir (org-attach-dir create-if-not-exist)))
+    (when attach-dir (org-open-file attach-dir))))
 
 (defun org-attach-reveal-in-emacs ()
   "Show the attachment directory of the current task in dired."
   (interactive)
-  (let ((attach-dir (org-attach-dir t)))
-    (dired attach-dir)))
+  (let ((attach-dir (org-attach-dir org-attach-dir-create-if-not-exists)))
+    (when attach-dir (dired attach-dir))))
 
 (defun org-attach-open (&optional in-emacs)
   "Open an attachment of the current task.
@@ -543,15 +574,17 @@ 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 org-attach-dir-create-if-not-exists)))
+    (if attach-dir
+	(let* ((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))
+      (message "No attachment exists!"))))
 
 (defun org-attach-open-in-emacs ()
   "Open attachment, force opening in Emacs.
@@ -570,6 +603,64 @@ Basically, this adds the path to the attachment directory, and a \"file:\"
 prefix."
   (concat "file:" (org-attach-expand file)))
 
+(defun org-attach-open-link (link &optional in-emacs)
+  "Attach link type LINK is expanded with the attached directory and opened.
+This is done in the same way as file-links are opened."
+  (interactive "P")
+  (let (line search)
+    (if (string-match "::\\([0-9]+\\)\\'" link)
+        (setq line (string-to-number (match-string 1 link))
+              link (substring link 0 (match-beginning 0)))
+      (if (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 (file link attached-dir)
+    (setq attached-dir (expand-file-name (org-attach-dir)))
+    (setq file (read-file-name "File: " attached-dir))
+    (let ((pwd (file-name-as-directory attached-dir))
+          (pwd1 (file-name-as-directory (abbreviate-file-name
+                                         attached-dir))))
+      (cond
+       ((string-match (concat "^" (regexp-quote pwd1) "\\(.+\\)") file)
+        (setq link  (concat "@:" (match-string 1 file))))
+       ((string-match (concat "^" (regexp-quote pwd) "\\(.+\\)")
+                      (expand-file-name file))
+        (setq link  (concat
+                     "@:" (match-string 1 (expand-file-name file)))))
+       (t (setq link (concat "@:" file)))))
+    link))
+
+(defun org-attach-export-link (link description format)
+  "Translate \"attached\" (@) LINK from Org mode format to exported FORMAT.
+Also includes the DESCRIPTION of the link in the export."
+  (save-excursion
+    (let (path desc)
+      (if (string-match "::\\([0-9]+\\)\\'" link)
+          (setq link (substring link 0 (match-beginning 0)))
+        (if (string-match "::\\(.+\\)\\'" link)
+            (setq link (substring link 0 (match-beginning 0)))))
+      (search-forward (concat "@:" (org-link-escape link)))
+      (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)))))
+
+(org-link-set-parameters "@"
+                         :follow 'org-attach-open-link
+                         :export 'org-attach-export-link
+                         :complete 'org-attach-complete-link)
+
 (defun org-attach-archive-delete-maybe ()
   "Maybe delete subtree attachments when archiving.
 This function is called by `org-archive-hook'.  The option
diff --git a/lisp/org.el b/lisp/org.el
index eb1affbc7..9ed663bb9 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -4428,6 +4428,7 @@ This is needed for font-lock setup.")
 		  (beg end))
 (declare-function org-agenda-set-restriction-lock "org-agenda" (&optional type))
 (declare-function org-agenda-skip "org-agenda" ())
+(declare-function org-attach-expand "org-attach" (&optional if-exists))
 (declare-function org-attach-reveal "org-attach" (&optional if-exists))
 (declare-function org-gnus-follow-link "org-gnus" (&optional group article))
 (declare-function org-indent-mode "org-indent" (&optional arg))
@@ -18721,7 +18722,7 @@ boundaries."
 	    ;; Check absolute, relative file names and explicit
 	    ;; "file:" links.  Also check link abbreviations since
 	    ;; some might expand to "file" links.
-	    (file-types-re (format "[][]\\[\\(?:file\\|[./~]%s\\)"
+	    (file-types-re (format "[][]\\[\\(?:file\\|@\\|[./~]%s\\)"
 				   (if (not link-abbrevs) ""
 				     (format "\\|\\(?:%s:\\)"
 					     (regexp-opt link-abbrevs))))))
@@ -18730,14 +18731,20 @@ boundaries."
 	   ;; Check if we're at an inline image, i.e., an image file
 	   ;; link without a description (unless INCLUDE-LINKED is
 	   ;; non-nil).
-	   (when (and (equal "file" (org-element-property :type link))
+	   (when (and (or (equal "file" (org-element-property :type link))
+                          (equal "@" (org-element-property :type link)))
 		      (or include-linked
 			  (null (org-element-contents link)))
 		      (string-match-p file-extension-re
 				      (org-element-property :path link)))
-	     (let ((file (expand-file-name
-			  (org-link-unescape
-			   (org-element-property :path link)))))
+	     (let ((file (if (equal "@" (org-element-property :type link))
+			     (require 'org-attach)
+                             (org-attach-expand
+                              (org-link-unescape
+			       (org-element-property :path link)))
+			   (expand-file-name
+			    (org-link-unescape
+			     (org-element-property :path link))))))
 	       (when (file-exists-p file)
 		 (let ((width
 			;; Apply `org-image-actual-width' specifications.
-- 
2.19.1.windows.1

