An org-attach link type [7.9.1 (7.9.1-elpa @ /home/youngfrog/.emacs.d/elpa/org-20120903/)]

An org-attach link type [7.9.1 (7.9.1-elpa @ /home/youngfrog/.emacs.d/elpa/org-20120903/)]

[Nicolas Richard]

Hello there,

Some people already have suggested and produced some code (see [1,2]) in
order to have an "attach" (or "att", as it was called) link type in
org-mode. I never found a org--complete-link function for these links
on the net, so I tried to write it for myself. In order to do that, I had
to modify org-insert-link so that the org-mode buffer is made current
(instead of *Org Links*) when calling org-link-try-special-completion.
This allows the org--complete-link family of functions to access the actual
org buffer from which org-insert-link was called. A patch in this direction
is at the end of my email. (This is the first time that I use
git-format-patch, I hope I got that right).

With that change, here is some code that adds an "att" link type with completion:

(defun org-att-complete-link ()
  "File completion for the \"att\" filetype in `org-mode'."
  (let* ((attach-dir (org-attach-dir nil))
         files file)
    (unless attach-dir
      (error "No attachment dir."))
    (setq files (find-lisp-find-files attach-dir "^[^.].*[^~]$")
          file (org-icompleting-read "Find attachment: "
                                       (mapcar 
                                        (lambda (x) (file-relative-name x attach-dir))
                                        files)
                                       nil t))
    (case org-att-complete-how
      ('full (org-attach-expand-link file))
      ('relative (concat "file:" attach-dir file))
      ('attach (concat "att:" file)))))
(defvar org-att-complete-how 'attach
"Determines how org-att-complete-link completes links to attachments.

It can be the symbols :
- `full' :: A \"file:\" link with full path is returned,
- `relative' :: a \"file:\" link containg a path relative to the directory where the org-file resides is returned, or
- `attach' :: an \"att:\" link is returned.

`full' is probably best avoided.")

(org-add-link-type "att" 'org-att-open-link)
(defun org-att-open-link (file)
  (org-open-file (org-attach-expand file)))

I hope that this is useful to anybody, and not too sloppy (I'm not
fluent in elisp)

[1] http://lists.gnu.org/archive/html/emacs-orgmode/2011-04/msg00010.html
[2] http://lists.gnu.org/archive/html/emacs-orgmode/2011-02/msg00952.html


The patch for the above mentionned change in org.el follows :

-- 8> --
Subject: [PATCH] Allow org--complete-read family of functions to access
 current-buffer

This allows for link-completion features based on information around the point.
---
 lisp/org.el | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/lisp/org.el b/lisp/org.el
index 3dfd073..fc5d709 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -9411,6 +9411,7 @@ If the DEFAULT-DESCRIPTION parameter is non-nil, this value will
 be used as the default description."
   (interactive "P")
   (let* ((wcf (current-window-configuration))
+	 (buffer (current-buffer))
 	 (region (if (org-region-active-p)
 		     (buffer-substring (region-beginning) (region-end))))
 	 (remove (and region (list (region-beginning) (region-end))))
@@ -9486,7 +9487,7 @@ Use TAB to complete link prefixes, then RET for type-specific completion support
 		    (and (equal ":" (substring link -1))
 			 (member (substring link 0 -1) all-prefixes)
 			 (setq link (substring link 0 -1))))
-		(setq link (org-link-try-special-completion link))))
+		(setq link (with-current-buffer buffer (org-link-try-special-completion link)))))
 	(set-window-configuration wcf)
 	(kill-buffer "*Org Links*"))
       (setq entry (assoc link org-stored-links))
-- 
1.7.12

Re: An org-attach link type [7.9.1 (7.9.1-elpa @ /home/youngfrog/.emacs.d/elpa/org-20120903/)]

[Viktor Rosenfeld]

Hi Nicolas,

I played around with your function and it's pretty nifty, but I had to make
a few changes to get it working:

- I have to load the "cl" module, otherwise the "case" function is void.
- I had to replace "find-lisp-find-files" with "directory-files" because
  the former does not exist on my Emacs installation. I use GNU Emacs
  24.2.1 on OS X compiled from MacPorts.
- I don't need to map the returned files to their relative paths.
- I couldn't find a difference between the 'relative and 'full options.
  "org-attach-expand-link" always returns the path as specified in the
  ATTACH_DIR property or constructed from the ID, but never the full
  (absolute) path unless it is explicitly specified. In other words, it
  does the same thing as your code for the 'relative options. I've
  removed both options and replaced it with a 'file option that calls
  "org-attach-expand-link".
- I use "attach" instead of "att" as a link prefix in my files and had
  to change the names of the functions. Sorry about that, but I did not
  want to fix all my links.

Code is below. I'm using Org-mode 7.9.1.

Cheers,
Viktor

#+BEGIN_SRC emacs-lisp
(defvar org-attach-complete-how 'attach
  "Determines how org-attach-complete-link completes links to attachments.

It can be the symbols :
- `file' :: A \"file:\" link is returned including the attachment directory.
- `attach' :: An \"attach:\" link is returned.")

(require 'cl)

(defun org-attach-complete-link ()
  "File completion for the \"attach\" filetype in `org-mode'."
  (let* ((attach-dir (org-attach-dir nil))
         files file)
    (unless attach-dir
      (error "No attachment dir."))
    (setq files (directory-files attach-dir nil "^[^.].*[^~]$" nil)
          file (org-icompleting-read "Find attachment: " files))
    (case org-attach-complete-how
      ('file (org-attach-expand-link file))
      ('attach (concat "attach:" file)))))
#+END_SRC

Nicolas Richard wrote:

> Hello there,
> 
> Some people already have suggested and produced some code (see [1,2]) in
> order to have an "attach" (or "att", as it was called) link type in
> org-mode. I never found a org--complete-link function for these links
> on the net, so I tried to write it for myself. In order to do that, I had
> to modify org-insert-link so that the org-mode buffer is made current
> (instead of *Org Links*) when calling org-link-try-special-completion.
> This allows the org--complete-link family of functions to access the actual
> org buffer from which org-insert-link was called. A patch in this direction
> is at the end of my email. (This is the first time that I use
> git-format-patch, I hope I got that right).
> 
> With that change, here is some code that adds an "att" link type with completion:
> 
> (defun org-att-complete-link ()
>   "File completion for the \"att\" filetype in `org-mode'."
>   (let* ((attach-dir (org-attach-dir nil))
>          files file)
>     (unless attach-dir
>       (error "No attachment dir."))
>     (setq files (find-lisp-find-files attach-dir "^[^.].*[^~]$")
>           file (org-icompleting-read "Find attachment: "
>                                        (mapcar 
>                                         (lambda (x) (file-relative-name x attach-dir))
>                                         files)
>                                        nil t))
>     (case org-att-complete-how
>       ('full (org-attach-expand-link file))
>       ('relative (concat "file:" attach-dir file))
>       ('attach (concat "att:" file)))))
> (defvar org-att-complete-how 'attach
> "Determines how org-att-complete-link completes links to attachments.
> 
> It can be the symbols :
> - `full' :: A \"file:\" link with full path is returned,
> - `relative' :: a \"file:\" link containg a path relative to the directory where the org-file resides is returned, or
> - `attach' :: an \"att:\" link is returned.
> 
> `full' is probably best avoided.")
> 
> (org-add-link-type "att" 'org-att-open-link)
> (defun org-att-open-link (file)
>   (org-open-file (org-attach-expand file)))
> 
> I hope that this is useful to anybody, and not too sloppy (I'm not
> fluent in elisp)
> 
> [1] http://lists.gnu.org/archive/html/emacs-orgmode/2011-04/msg00010.html
> [2] http://lists.gnu.org/archive/html/emacs-orgmode/2011-02/msg00952.html
> 
> 
> The patch for the above mentionned change in org.el follows :
> 
> -- 8> --
> Subject: [PATCH] Allow org--complete-read family of functions to access
>  current-buffer
> 
> This allows for link-completion features based on information around the point.
> ---
>  lisp/org.el | 3 ++-
>  1 file changed, 2 insertions(+), 1 deletion(-)
> 
> diff --git a/lisp/org.el b/lisp/org.el
> index 3dfd073..fc5d709 100644
> --- a/lisp/org.el
> +++ b/lisp/org.el
> @@ -9411,6 +9411,7 @@ If the DEFAULT-DESCRIPTION parameter is non-nil, this value will
>  be used as the default description."
>    (interactive "P")
>    (let* ((wcf (current-window-configuration))
> +	 (buffer (current-buffer))
>  	 (region (if (org-region-active-p)
>  		     (buffer-substring (region-beginning) (region-end))))
>  	 (remove (and region (list (region-beginning) (region-end))))
> @@ -9486,7 +9487,7 @@ Use TAB to complete link prefixes, then RET for type-specific completion support
>  		    (and (equal ":" (substring link -1))
>  			 (member (substring link 0 -1) all-prefixes)
>  			 (setq link (substring link 0 -1))))
> -		(setq link (org-link-try-special-completion link))))
> +		(setq link (with-current-buffer buffer (org-link-try-special-completion link)))))
>  	(set-window-configuration wcf)
>  	(kill-buffer "*Org Links*"))
>        (setq entry (assoc link org-stored-links))
> -- 
> 1.7.12
> 

Re: An org-attach link type [7.9.1 (7.9.1-elpa @ /home/youngfrog/.emacs.d/elpa/org-20120903/)]

[Nicolas Richard]

Hello Viktor,

Thanks for your input.

> - I have to load the "cl" module, otherwise the "case" function is
> void.

Sorry about that. I didn't notice it was from cl.

> - I had to replace "find-lisp-find-files" with "directory-files" because
>   the former does not exist on my Emacs installation. I use GNU Emacs
>   24.2.1 on OS X compiled from MacPorts.

Oops again. (require 'find-lisp) should fix that. The big difference
with directory-files is that find-lisp-find-files looks also in
subdirectories (I often attach subdirectories and like to link files
from therein). And it returns full paths, too, which explains some parts
of the rest of the code. 

> - I use "attach" instead of "att" as a link prefix in my files and had
>   to change the names of the functions. Sorry about that, but I did not
>   want to fix all my links.

That's fine, I only used "att" because it was the name I found in an
older discussion and I just copied the code.

-- 
Nico.

Re: An org-attach link type [7.9.1 (7.9.1-elpa @ /home/youngfrog/.emacs.d/elpa/org-20120903/)]

[Viktor Rosenfeld]

Hi Nicolas,

Nicolas Richard wrote:

> Hello Viktor,
> 
> Thanks for your input.
> 
> > - I have to load the "cl" module, otherwise the "case" function is
> > void.
> 
> Sorry about that. I didn't notice it was from cl.
> 
> > - I had to replace "find-lisp-find-files" with "directory-files" because
> >   the former does not exist on my Emacs installation. I use GNU Emacs
> >   24.2.1 on OS X compiled from MacPorts.
> 
> Oops again. (require 'find-lisp) should fix that. The big difference
> with directory-files is that find-lisp-find-files looks also in
> subdirectories (I often attach subdirectories and like to link files
> from therein). And it returns full paths, too, which explains some parts
> of the rest of the code. 

If "find-lisp-find-files" returns full paths then the discrimination in
org-attach-complete-how makes sense. Pretty cool.

Cheers,
Viktor

Re: An org-attach link type [7.9.1 (7.9.1-elpa @ /home/youngfrog/.emacs.d/elpa/org-20120903/)]

[Bastien]

Hi Nicolas,

I pushed a slightly modified version of your patch in master.

Thanks for this!

If you feel like adding the attach link type to org-attach.el
please go ahead and provide a patch.  Beware of the format of
the patch, though: it must contain a proper ChangeLog.  See

  http://orgmode.org/worg/org-contribute.html#sec-5

for more details.

Thanks in advance!

-- 
 Bastien

Re: An org-attach link type [7.9.1 (7.9.1-elpa @ /home/youngfrog/.emacs.d/elpa/org-20120903/)]

[Nicolas Richard]

Bastien <bzg@altern.org> writes:

Hello,

> If you feel like adding the attach link type to org-attach.el
> please go ahead and provide a patch.

Ok, so here it is, in two parts.

The first patch (included below) modifies org-attach-file-list to try
and make it slightly more customizable :
- The DIR argument is made optional (when given, old behaviour is used)
- When that argument is not given, the function obeys a customizable
  option saying which attached files it should list for the subtree at
  point. That option defaults to the old behaviour.
- Accordingly, functions that use org-attach-file-list are modified.

The second patch (which should be independent from this one) follows in
a different email, with the actual completing function.

>  Beware of the format of
> the patch, though: it must contain a proper ChangeLog.  See

I did my best. Now I hope its sufficient.

-- 
N.


-- 8> --

From 0b675ab013de01422f55669ea1aebd8a77c1f7af Mon Sep 17 00:00:00 2001
From: "nrichard (geodiff-mac3)" <nrichard@ulb.ac.be>
Date: Thu, 27 Sep 2012 17:37:03 +0200
Subject: [PATCH 1/2] (org-attach) Add some options for listing attachments

* lisp/org-attach.el (org-attach-file-list-method): new variable
(org-attach-file-list-skip-re): new variable
(org-attach-file-list): use new variables to customize which files are
listed. Moreover the argument DIR is now optional : if it is given,
the old behaviour is kept for backward compatibility, otherwise
attachments are listed for the subtree at point.
(org-attach-delete-one): drop the now optional argument
(org-attach-sync): drop the now optional argument
(org-attach-open): drop the now optional argument
---
 lisp/org-attach.el | 59 +++++++++++++++++++++++++++++++++++++++++++++---------
 1 file changed, 50 insertions(+), 9 deletions(-)

diff --git a/lisp/org-attach.el b/lisp/org-attach.el
index e02d7e0..4a4c195 100644
--- a/lisp/org-attach.el
+++ b/lisp/org-attach.el
@@ -71,6 +71,28 @@ attachments is not kept in this property."
 	  (const :tag "None" nil)
 	  (string :tag "Tag")))
 
+(defcustom org-attach-file-list-method 'default
+  "Determine what files are to be listed as attached files.
+
+It can be the symbols :
+- `default' :: list all files and directories in the attachment directory.
+- `explicit' :: list only attached files that are explicitly listed in
+                the `org-attach-file-list-property' (Attachments)
+                property.  (unreliable)
+- `recurse' :: list all files in the attachment directory, recursively.
+
+See also variable `org-attach-file-list-skip-re'."
+  :group 'org-attach
+  :type '(choice
+	  (const :tag "List content of the attachment directory" default)
+	  (const :tag "List content of the property `org-attach-file-list-property'" explicit)
+	  (const :tag "List files in the attachment directory recursively" recurse)))
+
+(defcustom org-attach-file-list-skip-re "\\`\\.\\|~\\'"
+  "Files matching this regexp will be skipped when listing attachments."
+  :group 'org-attach
+  :type 'regexp)
+
 (defcustom org-attach-method 'cp
   "The preferred method to attach a file.
 Allowed values are:
@@ -350,7 +372,7 @@ The attachment is created as an Emacs buffer."
   "Delete a single attachment."
   (interactive)
   (let* ((attach-dir (org-attach-dir t))
-	 (files (org-attach-file-list attach-dir))
+	 (files (org-attach-file-list))
 	 (file (or file
 		   (org-icompleting-read
 		    "Delete attachment: "
@@ -389,7 +411,7 @@ This can be used after files have been added externally."
     (org-entry-delete (point) org-attach-file-list-property))
   (let ((attach-dir (org-attach-dir)))
     (when attach-dir
-      (let ((files (org-attach-file-list attach-dir)))
+      (let ((files (org-attach-file-list)))
 	(and files (org-attach-tag))
 	(when org-attach-file-list-property
 	  (dolist (file files)
@@ -397,12 +419,31 @@ This can be used after files have been added externally."
 	      (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 \"~\"."
-  (delq nil
-	(mapcar (lambda (x) (if (string-match "^\\." x) nil x))
-		(directory-files dir nil "[^~]\\'"))))
+(declare-function find-lisp-find-files "find-lisp")
+
+(defun org-attach-file-list (&optional dir)
+  "List files in the directory DIR, or attachments to the subtree at point.
+
+When DIR is not given, list attachments to the subtree at point
+according to `org-attach-file-list-method'.
+
+When DIR is given, list files in that directory.
+
+In both cases, files matching `org-attach-file-list-skip-re' are
+ignored.  Default is to skip files starting with a \".\" and files
+ending in \"~\"."
+  (let* ((attach-dir (or dir (org-attach-dir nil)))
+         (list (cond
+                ; when DIR is explicitly given, use old method for backward compatibility.
+                ((or (eq org-attach-file-list-method 'default) dir)
+                 (directory-files attach-dir))
+                ((eq org-attach-file-list-method 'explicit)
+                 (org-entry-get-multivalued-property nil org-attach-file-list-property))
+                ((eq org-attach-file-list-method 'recurse)
+                 (progn (require 'find-lisp)
+                        (mapcar (lambda (x) (file-relative-name x attach-dir)) (find-lisp-find-files attach-dir ""))))))
+         (skip-function (lambda (x) (if (string-match org-attach-file-list-skip-re x) nil x))))
+    (delq nil (mapcar skip-function list))))
 
 (defun org-attach-reveal (&optional if-exists)
   "Show the attachment directory of the current task in dired."
@@ -425,7 +466,7 @@ 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))
+	 (files (org-attach-file-list))
 	 (file (if (= (length files) 1)
 		   (car files)
 		 (org-icompleting-read "Open attachment: "
-- 
1.7.12

Re: An org-attach link type [7.9.1 (7.9.1-elpa @ /home/youngfrog/.emacs.d/elpa/org-20120903/)]

[Bastien]

Hi Nicolas,

thanks for the patches.  Unless I'm wrong, you did not assign your
copyright to the FSF yet for such changes.  Would you like to?

If yes please fill this form:

  http://orgmode.org/cgit.cgi/org-mode.git/plain/request-assign-future.txt

It can take 1-2 months before the process is over, so your change 
will likely be in 8.0.

Also one formatting convention for the ChangeLog and the code:
sentences start with an uppercase letter and end with two spaces.
This is important, otherwise I have to manually fix this.

Thanks for this contribution!

-- 
 Bastien

Re: An org-attach link type [7.9.1 (7.9.1-elpa @ /home/youngfrog/.emacs.d/elpa/org-20120903/)]

[Nicolas Richard]

Bastien <bzg@altern.org> writes:
> If you feel like adding the attach link type to org-attach.el

Second part, which is the actual "attach link" part.

-- 
N.

-- 8> --

From 85f5c10d8d448e56458377f166413f7de6458563 Mon Sep 17 00:00:00 2001
From: "nrichard (geodiff-mac3)" <nrichard@ulb.ac.be>
Date: Thu, 27 Sep 2012 17:38:43 +0200
Subject: [PATCH 2/2] (org-attach) Add an /attach/ link type, with completion

* org-attach.el (org-attach-complete-how): new variable for link completion
(org-attach-complete-link): new function for link completion.
---
 lisp/org-attach.el | 28 ++++++++++++++++++++++++++++
 1 file changed, 28 insertions(+)

diff --git a/lisp/org-attach.el b/lisp/org-attach.el
index 4a4c195..3a1e273 100644
--- a/lisp/org-attach.el
+++ b/lisp/org-attach.el
@@ -132,6 +132,18 @@ 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-complete-how 'attach
+  "Determine how `org-attach-complete-link' completes links to attachments.
+
+It can be one of the symbols :
+- `file' :: a \"file:\" link is returned (the exact path inserted
+            depends on `org-link-file-path-type'),
+- `attach' :: an \"attach:\" link is returned (default)."
+  :group 'org-attach
+  :type '(choice
+	  (const :tag "File" file)
+	  (const :tag "Attach (default)" attach)))
+
 ;;;###autoload
 (defun org-attach ()
   "The dispatcher for attachment commands.
@@ -490,6 +502,22 @@ Basically, this adds the path to the attachment directory, and a \"file:\"
 prefix."
   (concat "file:" (org-attach-expand file)))
 
+(defun org-attach-complete-link ()
+  "Read a filename from the attachment directory, with completion.
+
+This provides link completion for the \"attach\" type. The exact
+behaviour depends on the variable `org-attach-complete-how'."
+  (let* ((attach-dir (or (org-attach-dir nil) (error "No attachment dir")))
+         (files (org-attach-file-list)) ; names relative to attach dir.
+         (file (org-icompleting-read "Find attachment: " files nil t)))
+    (cond
+      ((eq org-attach-complete-how 'file) (org-attach-expand-link file))
+      ((eq org-attach-complete-how 'attach) (concat "attach:" file)))))
+
+(org-add-link-type "attach" 'org-attach-open-link)
+(defun org-attach-open-link (file)
+  (org-open-file (org-attach-expand file)))
+
 (provide 'org-attach)
 
 ;;; org-attach.el ends here
-- 
1.7.12