* IMAP support for VM links in orgmode (org-vm.el)
@ 2012-01-19 13:34 Konrad Hinsen
2012-01-20 15:36 ` Bastien
2012-01-20 16:07 ` Bastien
0 siblings, 2 replies; 3+ messages in thread
From: Konrad Hinsen @ 2012-01-19 13:34 UTC (permalink / raw)
To: emacs-orgmode-mXXj517/zsQ, viewmail-info-qX2TKyscuCcdnm+yROfE0A
[-- Attachment #1: Type: text/plain, Size: 753 bytes --]
The attached patch (relative to yesterday's state of the orgmode git
repository) adds the possibility to have org-mode links to IMAP folders in
VM and to messages inside IMAP folders. It requires VM 8.2.0a or later.
IMAP links have the format
vm-imap:account:imap-folder-name
for a folder and
vm-imap:account:imap-folder-name#message-id
for a message. The account:imap-folder notation is the same that is used in
VM when entering a folder name in the minibuffer.
I ended up creating a new link type (vm-imap) instead of overloading the vm
link type with some cryptic syntax. This also seems more consistent with
how VM considers IMAP folders to be in a separate universe from local
folders.
I hope this will be useful to others!
Konrad.
[-- Attachment #2: org-vm.patch --]
[-- Type: application/octet-stream, Size: 8929 bytes --]
diff --git a/doc/org.texi b/doc/org.texi
index 6dad96a..b238210 100644
--- a/doc/org.texi
+++ b/doc/org.texi
@@ -3243,6 +3243,8 @@ mailto:adent@@galaxy.net @r{Mail link}
vm:folder @r{VM folder link}
vm:folder#id @r{VM message link}
vm://myself@@some.where.org/folder#id @r{VM on remote machine}
+vm-imap:account:folder @r{VM IMAP folder link}
+vm-imap:account:folder#id @r{VM IMAP message link}
wl:folder @r{WANDERLUST folder link}
wl:folder#id @r{WANDERLUST message link}
mhe:folder @r{MH-E folder link}
@@ -6698,21 +6700,21 @@ similar way.}:
@vindex org-from-is-user-regexp
@smallexample
-Link type | Available keywords
-------------------------+----------------------------------------------
-bbdb | %:name %:company
-irc | %:server %:port %:nick
-vm, wl, mh, mew, rmail | %:type %:subject %:message-id
- | %:from %:fromname %:fromaddress
- | %:to %:toname %:toaddress
- | %:date @r{(message date header field)}
- | %:date-timestamp @r{(date as active timestamp)}
- | %:date-timestamp-inactive @r{(date as inactive timestamp)}
- | %:fromto @r{(either "to NAME" or "from NAME")@footnote{This will always be the other, not the user. See the variable @code{org-from-is-user-regexp}.}}
-gnus | %:group, @r{for messages also all email fields}
-w3, w3m | %:url
-info | %:file %:node
-calendar | %:date
+Link type | Available keywords
+---------------------------------+----------------------------------------------
+bbdb | %:name %:company
+irc | %:server %:port %:nick
+vm, vm-imap, wl, mh, mew, rmail | %:type %:subject %:message-id
+ | %:from %:fromname %:fromaddress
+ | %:to %:toname %:toaddress
+ | %:date @r{(message date header field)}
+ | %:date-timestamp @r{(date as active timestamp)}
+ | %:date-timestamp-inactive @r{(date as inactive timestamp)}
+ | %:fromto @r{(either "to NAME" or "from NAME")@footnote{This will always be the other, not the user. See the variable @code{org-from-is-user-regexp}.}}
+gnus | %:group, @r{for messages also all email fields}
+w3, w3m | %:url
+info | %:file %:node
+calendar | %:date
@end smallexample
@noindent
diff --git a/lisp/org-vm.el b/lisp/org-vm.el
index b6975ff..b509c41 100644
--- a/lisp/org-vm.el
+++ b/lisp/org-vm.el
@@ -6,6 +6,10 @@
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;;
+;; Support for IMAP folders added
+;; by Konrad Hinsen <konrad dot hinsen at fastmail dot net>
+;; Requires VM 8.2.0a or later.
+;;
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software: you can redistribute it and/or modify
@@ -42,11 +46,17 @@
(declare-function vm-su-message-id "ext:vm-summary" (m))
(declare-function vm-su-subject "ext:vm-summary" (m))
(declare-function vm-summarize "ext:vm-summary" (&optional display raise))
+(declare-function vm-imap-folder-p "ext:vm-save" ())
+(declare-function vm-imap-find-spec-for-buffer "ext:vm-imap" (buffer))
+(declare-function vm-imap-folder-for-spec "ext:vm-imap" (spec))
+(declare-function vm-imap-parse-spec-to-list "ext:vm-imap" (spec))
+(declare-function vm-imap-spec-for-account "ext:vm-imap" (account))
(defvar vm-message-pointer)
(defvar vm-folder-directory)
;; Install the link type
(org-add-link-type "vm" 'org-vm-open)
+(org-add-link-type "vm-imap" 'org-vm-imap-open)
(add-hook 'org-store-link-functions 'org-vm-store-link)
;; Implementation
@@ -61,11 +71,11 @@
(save-excursion
(vm-select-folder-buffer)
(let* ((message (car vm-message-pointer))
- (folder buffer-file-name)
- (subject (vm-su-subject message))
+ (subject (vm-su-subject message))
(to (vm-get-header-contents message "To"))
(from (vm-get-header-contents message "From"))
- (message-id (vm-su-message-id message))
+ (message-id (vm-su-message-id message))
+ (link-type (if (vm-imap-folder-p) "vm-imap" "vm"))
(date (vm-get-header-contents message "Date"))
(date-ts (and date (format-time-string
(org-time-stamp-format t)
@@ -73,20 +83,24 @@
(date-ts-ia (and date (format-time-string
(org-time-stamp-format t t)
(date-to-time date))))
- desc link)
- (org-store-link-props :type "vm" :from from :to to :subject subject
+ folder desc link)
+ (if (vm-imap-folder-p)
+ (let ((spec (vm-imap-find-spec-for-buffer (current-buffer))))
+ (setq folder (vm-imap-folder-for-spec spec)))
+ (progn
+ (setq folder (abbreviate-file-name buffer-file-name))
+ (if (and vm-folder-directory
+ (string-match (concat "^" (regexp-quote vm-folder-directory))
+ folder))
+ (setq folder (replace-match "" t t folder)))))
+ (setq message-id (org-remove-angle-brackets message-id))
+ (org-store-link-props :type link-type :from from :to to :subject subject
:message-id message-id)
(when date
(org-add-link-props :date date :date-timestamp date-ts
:date-timestamp-inactive date-ts-ia))
- (setq message-id (org-remove-angle-brackets message-id))
- (setq folder (abbreviate-file-name folder))
- (if (and vm-folder-directory
- (string-match (concat "^" (regexp-quote vm-folder-directory))
- folder))
- (setq folder (replace-match "" t t folder)))
(setq desc (org-email-link-description))
- (setq link (org-make-link "vm:" folder "#" message-id))
+ (setq link (org-make-link (concat link-type ":") folder "#" message-id))
(org-add-link-props :link link :description desc)
link))))
@@ -121,21 +135,46 @@
(setq folder (format "/%s@%s:%s" user host file))))))
(when folder
(funcall (cdr (assq 'vm org-link-frame-setup)) folder readonly)
- (sit-for 0.1)
(when article
- (require 'vm-search)
- (vm-select-folder-buffer)
- (widen)
- (let ((case-fold-search t))
- (goto-char (point-min))
- (if (not (re-search-forward
- (concat "^" "message-id: *" (regexp-quote article))))
- (error "Could not find the specified message in this folder"))
- (vm-isearch-update)
- (vm-isearch-narrow)
- (vm-preview-current-message)
- (vm-summarize)))))
+ (org-vm-select-message (org-add-angle-brackets article)))))
+
+(defun org-vm-imap-open (path)
+ "Follow a VM link to an IMAP folder"
+ (require 'vm-imap)
+ (when (string-match "\\([^:]+\\):\\([^#]+\\)#?\\(.+\\)?" path)
+ (let* ((account-name (match-string 1 path))
+ (mailbox-name (match-string 2 path))
+ (message-id (match-string 3 path))
+ (account-spec (vm-imap-parse-spec-to-list
+ (vm-imap-spec-for-account account-name)))
+ (mailbox-spec (mapconcat 'identity
+ (append (butlast account-spec 4)
+ (cons mailbox-name
+ (last account-spec 3)))
+ ":")))
+ (funcall (cdr (assq 'vm-imap org-link-frame-setup))
+ mailbox-spec)
+ (when message-id
+ (org-vm-select-message (org-add-angle-brackets message-id))))))
+
+(defun org-vm-select-message (message-id)
+ "Go to the message with message-id in the current folder."
+ (require 'vm-search)
+ (sit-for 0.1)
+ (vm-select-folder-buffer)
+ (widen)
+ (let ((case-fold-search t))
+ (goto-char (point-min))
+ (if (not (re-search-forward
+ (concat "^" "message-id: *" (regexp-quote message-id))))
+ (error "Could not find the specified message in this folder"))
+ (vm-isearch-update)
+ (vm-isearch-narrow)
+ (vm-preview-current-message)
+ (vm-summarize)))
(provide 'org-vm)
+
+
;;; org-vm.el ends here
diff --git a/lisp/org.el b/lisp/org.el
index e878626..88638c1 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -1549,6 +1549,7 @@ in the search text."
(defcustom org-link-frame-setup
'((vm . vm-visit-folder-other-frame)
+ (vm-imap . vm-visit-imap-folder-other-frame)
(gnus . org-gnus-no-new-news)
(file . find-file-other-window)
(wl . wl-other-frame))
^ permalink raw reply related [flat|nested] 3+ messages in thread
* Re: IMAP support for VM links in orgmode (org-vm.el)
2012-01-19 13:34 IMAP support for VM links in orgmode (org-vm.el) Konrad Hinsen
@ 2012-01-20 15:36 ` Bastien
2012-01-20 16:07 ` Bastien
1 sibling, 0 replies; 3+ messages in thread
From: Bastien @ 2012-01-20 15:36 UTC (permalink / raw)
To: Konrad Hinsen; +Cc: viewmail-info, emacs-orgmode
Hi Konrad,
Konrad Hinsen <konrad.hinsen@fastmail.net> writes:
> The attached patch (relative to yesterday's state of the orgmode git
> repository) adds the possibility to have org-mode links to IMAP folders in
> VM and to messages inside IMAP folders. It requires VM 8.2.0a or
> later.
The patch looks good to me. Did you sign FSF papers?
If not, I cannot apply the patch, as it is non-trivial...
I'm not a VM user myself, so please VM folks test this
patch and report any problem.
Best,
--
Bastien
^ permalink raw reply [flat|nested] 3+ messages in thread
* Re: IMAP support for VM links in orgmode (org-vm.el)
2012-01-19 13:34 IMAP support for VM links in orgmode (org-vm.el) Konrad Hinsen
2012-01-20 15:36 ` Bastien
@ 2012-01-20 16:07 ` Bastien
1 sibling, 0 replies; 3+ messages in thread
From: Bastien @ 2012-01-20 16:07 UTC (permalink / raw)
To: Konrad Hinsen; +Cc: viewmail-info, emacs-orgmode
Konrad Hinsen <konrad.hinsen@fastmail.net> writes:
> The attached patch (relative to yesterday's state of the orgmode git
> repository) adds the possibility to have org-mode links to IMAP folders in
> VM and to messages inside IMAP folders. It requires VM 8.2.0a or
> later.
Applied -- thanks!
PS: wrt my previous message, I forgot Konrad already signed FSF papers.
--
Bastien
^ permalink raw reply [flat|nested] 3+ messages in thread
end of thread, other threads:[~2012-01-20 16:06 UTC | newest]
Thread overview: 3+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2012-01-19 13:34 IMAP support for VM links in orgmode (org-vm.el) Konrad Hinsen
2012-01-20 15:36 ` Bastien
2012-01-20 16:07 ` Bastien
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).