* [patch] org-wl: Code cleanup and enhancements
@ 2010-05-07 15:36 David Maus
2010-05-08 5:33 ` Carsten Dominik
0 siblings, 1 reply; 3+ messages in thread
From: David Maus @ 2010-05-07 15:36 UTC (permalink / raw)
To: org-mode
[-- Attachment #1.1.1: Type: text/plain, Size: 621 bytes --]
Attached patch for org-wl.el contains some code cleanup and two
enhancements:
1. Store and open link to Wanderlust folders.
2. Store link to Wanderlust message while visiting the message
buffer.
Up to now it was only possible to store a link to a message when
point was in the message summary.
@Carsten: This patch also contains the update for ChangeLog. I hope
merging different ChangeLog entries works out of the box. I.e. there
will be two other patches with an updated ChangeLog as well.
HTH
-- David
--
OpenPGP... 0x99ADB83B5A4478E6
Jabber.... dmjena@jabber.org
Email..... dmaus@ictsoc.de
[-- Attachment #1.1.2: org-wl-cleanup-features.diff --]
[-- Type: application/octet-stream, Size: 9293 bytes --]
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 88d477e..426ac21 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,18 @@
+2010-05-07 David Maus <dmaus@ictsoc.de>
+
+ * org-wl.el (org-wl-message-field): New function. Return
+ content of header field in message entity.
+ (org-wl-store-link): Call `org-wl-store-link-folder' or
+ `org-wl-store-link-message' depending on major-mode.
+ (org-wl-store-link-folder): New function. Store link to
+ Wanderlust folder.
+ (org-wl-store-link-message): New function. Store link to
+ Wanderlust message.
+ (org-wl-store-link-message): Store link to message while
+ visiting message.
+ (org-wl-open): Don't try to jump to message when opening a
+ folder link.
+
2010-05-07 Carsten Dominik <carsten.dominik@gmail.com>
* org-table.el (org-table-recalculate-buffer-tables)
diff --git a/lisp/org-wl.el b/lisp/org-wl.el
index 0534342..4a76904 100644
--- a/lisp/org-wl.el
+++ b/lisp/org-wl.el
@@ -86,9 +86,14 @@ googlegroups otherwise."
(declare-function wl-summary-registered-temp-mark "ext:wl-action" (number))
(declare-function wl-folder-goto-folder-subr "ext:wl-folder"
(&optional folder sticky))
+(declare-function wl-folder-get-petname "ext:wl-folder" (name))
+(declare-function wl-folder-get-entity-from-buffer "ext:wl-folder"
+ (&optional getid))
+(declare-function wl-folder-buffer-group-p "ext:wl-folder")
(defvar wl-init)
(defvar wl-summary-buffer-elmo-folder)
(defvar wl-summary-buffer-folder-name)
+(defvar wl-folder-group-regexp)
(defconst org-wl-folder-types
'(("%" . imap) ("-" . nntp) ("+" . mh) ("=" . spool)
@@ -96,7 +101,6 @@ googlegroups otherwise."
("*" . multi) ("/" . filter) ("|" . pipe) ("'" . internal))
"List of folder indicators. See Wanderlust manual, section 3.")
-
;; Install the link type
(org-add-link-type "wl" 'org-wl-open)
(add-hook 'org-store-link-functions 'org-wl-store-link)
@@ -123,79 +127,102 @@ folder name determines the the folder type."
nil))))
type))
+(defun org-wl-message-field (field entity)
+ "Return content of FIELD in ENTITY.
+FIELD is a symbol of a rfc822 message header field.
+ENTITY is a message entity."
+ (let ((content (elmo-message-entity-field entity field)))
+ (if (listp content) (car content) content)))
+
(defun org-wl-store-link ()
- "Store a link to a WL folder or message."
- (when (eq major-mode 'wl-summary-mode)
- (let* ((msgnum (wl-summary-message-number))
- (mark-info (wl-summary-registered-temp-mark msgnum))
- (folder-name
- (if (and org-wl-link-to-refile-destination
- mark-info
- (equal (nth 1 mark-info) "o")) ; marked as refile
- (nth 2 mark-info)
- wl-summary-buffer-folder-name))
- (folder-type (org-wl-folder-type folder-name))
- (message-id (elmo-message-field wl-summary-buffer-elmo-folder
- msgnum 'message-id))
- (wl-message-entity
- (if (fboundp 'elmo-message-entity)
- (elmo-message-entity
- wl-summary-buffer-elmo-folder msgnum)
- (elmo-msgdb-overview-get-entity
- msgnum (wl-summary-buffer-msgdb))))
- (from (let ((from-field (elmo-message-entity-field wl-message-entity
- 'from)))
- (if (listp from-field)
- (car from-field)
- from-field)))
- (to (let ((to-field (elmo-message-entity-field wl-message-entity
- 'to)))
- (if (listp to-field)
- (car to-field)
- to-field)))
- (xref (let ((xref-field (elmo-message-entity-field wl-message-entity
- 'xref)))
- (if (listp xref-field)
- (car xref-field)
- xref-field)))
- (subject (let (wl-thr-indent-string wl-parent-message-entity)
- (wl-summary-line-subject)))
- desc link)
-
- ;; remove text properties of subject string to avoid possible bug
- ;; when formatting the subject
- ;; (Emacs bug #5306, fixed)
- (set-text-properties 0 (length subject) nil subject)
-
- ;; maybe remove filter condition
- (when (and (eq folder-type 'filter) org-wl-link-remove-filter)
- (while (eq (org-wl-folder-type folder-name) 'filter)
- (setq folder-name
- (replace-regexp-in-string "^/[^/]+/" "" folder-name))))
-
- ;; maybe create http link
- (cond
- ((and (eq folder-type 'shimbun) org-wl-shimbun-prefer-web-links xref)
- (org-store-link-props :type "http" :link xref :description subject
- :from from :to to :message-id message-id
- :subject subject))
- ((and (eq folder-type 'nntp) org-wl-nntp-prefer-web-links)
- (setq link (format
- (if (string-match "gmane\\." folder-name)
- "http://mid.gmane.org/%s"
- "http://groups.google.com/groups/search?as_umsgid=%s")
- (org-fixup-message-id-for-http message-id)))
- (org-store-link-props :type "http" :link link :description subject
- :from from :to to :message-id message-id
- :subject subject))
- (t
- (org-store-link-props :type "wl" :from from :to to
- :subject subject :message-id message-id)
- (setq message-id (org-remove-angle-brackets message-id))
- (setq desc (org-email-link-description))
- (setq link (org-make-link "wl:" folder-name "#" message-id))
- (org-add-link-props :link link :description desc)))
- (or link xref))))
+ "Store a link to a WL message or folder."
+ (cond
+ ((memq major-mode '(wl-summary-mode mime-view-mode))
+ (org-wl-store-link-message))
+ ((eq major-mode 'wl-folder-mode)
+ (org-wl-store-link-folder))
+ (t
+ nil)))
+
+(defun org-wl-store-link-folder ()
+ "Store a link to a WL folder."
+ (let* ((folder (wl-folder-get-entity-from-buffer))
+ (petname (wl-folder-get-petname folder))
+ (link (org-make-link "wl:" folder)))
+ (save-excursion
+ (beginning-of-line)
+ (if (and (wl-folder-buffer-group-p)
+ (looking-at wl-folder-group-regexp))
+ (error "Cannot store link to folder group: %s" folder))
+ (org-store-link-props :type "wl" :description petname
+ :link link)
+ link)))
+
+(defun org-wl-store-link-message ()
+ "Store a link to a WL message."
+ (save-excursion
+ (let ((buf (if (eq major-mode 'wl-summary-mode)
+ (current-buffer)
+ (and (boundp 'wl-message-buffer-cur-summary-buffer)
+ wl-message-buffer-cur-summary-buffer))))
+ (when buf
+ (with-current-buffer buf
+ (let* ((msgnum (wl-summary-message-number))
+ (mark-info (wl-summary-registered-temp-mark msgnum))
+ (folder-name
+ (if (and org-wl-link-to-refile-destination
+ mark-info
+ (equal (nth 1 mark-info) "o")) ; marked as refile
+ (nth 2 mark-info)
+ wl-summary-buffer-folder-name))
+ (folder-type (org-wl-folder-type folder-name))
+ (wl-message-entity
+ (if (fboundp 'elmo-message-entity)
+ (elmo-message-entity
+ wl-summary-buffer-elmo-folder msgnum)
+ (elmo-msgdb-overview-get-entity
+ msgnum (wl-summary-buffer-msgdb))))
+ (message-id (org-wl-message-field 'message-id wl-message-entity))
+ (from (org-wl-message-field 'from wl-message-entity))
+ (to (org-wl-message-field 'to wl-message-entity))
+ (xref (org-wl-message-field 'xref wl-message-entity))
+ (subject (org-wl-message-field 'subject wl-message-entity))
+ desc link)
+
+ ;; remove text properties of subject string to avoid possible bug
+ ;; when formatting the subject
+ ;; (Emacs bug #5306, fixed)
+ (set-text-properties 0 (length subject) nil subject)
+
+ ;; maybe remove filter condition
+ (when (and (eq folder-type 'filter) org-wl-link-remove-filter)
+ (while (eq (org-wl-folder-type folder-name) 'filter)
+ (setq folder-name
+ (replace-regexp-in-string "^/[^/]+/" "" folder-name))))
+
+ ;; maybe create http link
+ (cond
+ ((and (eq folder-type 'shimbun) org-wl-shimbun-prefer-web-links xref)
+ (org-store-link-props :type "http" :link xref :description subject
+ :from from :to to :message-id message-id
+ :subject subject))
+ ((and (eq folder-type 'nntp) org-wl-nntp-prefer-web-links)
+ (setq link (format
+ (if (string-match "gmane\\." folder-name)
+ "http://mid.gmane.org/%s"
+ "http://groups.google.com/groups/search?as_umsgid=%s")
+ (org-fixup-message-id-for-http message-id)))
+ (org-store-link-props :type "http" :link link :description subject
+ :from from :to to :message-id message-id
+ :subject subject))
+ (t
+ (org-store-link-props :type "wl" :from from :to to
+ :subject subject :message-id message-id)
+ (setq message-id (org-remove-angle-brackets message-id))
+ (setq desc (org-email-link-description))
+ (setq link (org-make-link "wl:" folder-name "#" message-id))
+ (org-add-link-props :link link :description desc)))
+ (or link xref)))))))
(defun org-wl-open (path)
"Follow the WL message link specified by PATH.
@@ -228,9 +255,9 @@ for namazu index."
;; beginning of the current line. So, restore the point
;; in the old buffer.
(goto-char old-point))
- (and (wl-summary-jump-to-msg-by-message-id (org-add-angle-brackets
- article))
- (wl-summary-redisplay)))))
+ (and article (wl-summary-jump-to-msg-by-message-id (org-add-angle-brackets
+ article))
+ (wl-summary-redisplay)))))
(provide 'org-wl)
[-- Attachment #1.2: Type: application/pgp-signature, Size: 230 bytes --]
[-- Attachment #2: Type: text/plain, Size: 201 bytes --]
_______________________________________________
Emacs-orgmode mailing list
Please use `Reply All' to send replies to the list.
Emacs-orgmode@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-orgmode
^ permalink raw reply related [flat|nested] 3+ messages in thread
* Re: [patch] org-wl: Code cleanup and enhancements
2010-05-07 15:36 [patch] org-wl: Code cleanup and enhancements David Maus
@ 2010-05-08 5:33 ` Carsten Dominik
2010-05-08 12:25 ` David Maus
0 siblings, 1 reply; 3+ messages in thread
From: Carsten Dominik @ 2010-05-08 5:33 UTC (permalink / raw)
To: David Maus; +Cc: org-mode
On May 7, 2010, at 5:36 PM, David Maus wrote:
> Attached patch for org-wl.el contains some code cleanup and two
> enhancements:
>
> 1. Store and open link to Wanderlust folders.
>
> 2. Store link to Wanderlust message while visiting the message
> buffer.
>
> Up to now it was only possible to store a link to a message when
> point was in the message summary.
>
> @Carsten: This patch also contains the update for ChangeLog. I hope
> merging different ChangeLog entries works out of the box. I.e. there
> will be two other patches with an updated ChangeLog as well.
Hi David, I have applied the patch, thanks. Also, thanks for
providing the ChangeLog. These never apply cleanly, because
I usually have made other changes in the mean time. But it still
saves me time if you provide the entires.
The best way would still be to publish a git branch with your changes,
then I can merge and fix the "conflict" the easiest.
I did have a problem with this particular patch to org-wl.el, and so
I did apply the patch by hand - please double-check if all went well.
Thanks! Your contributions are much appreciated.
- Carsten
^ permalink raw reply [flat|nested] 3+ messages in thread
* Re: [patch] org-wl: Code cleanup and enhancements
2010-05-08 5:33 ` Carsten Dominik
@ 2010-05-08 12:25 ` David Maus
0 siblings, 0 replies; 3+ messages in thread
From: David Maus @ 2010-05-08 12:25 UTC (permalink / raw)
To: Carsten Dominik; +Cc: org-mode
[-- Attachment #1.1: Type: text/plain, Size: 709 bytes --]
Carsten Dominik wrote:
>Hi David, I have applied the patch, thanks. Also, thanks for
>providing the ChangeLog. These never apply cleanly, because
>I usually have made other changes in the mean time. But it still
>saves me time if you provide the entires.
>The best way would still be to publish a git branch with your changes,
>then I can merge and fix the "conflict" the easiest.
Okay, I'll do this for the next ones.
>I did have a problem with this particular patch to org-wl.el, and so
>I did apply the patch by hand - please double-check if all went well.
Everything is where it belongs.
Regards,
-- David
--
OpenPGP... 0x99ADB83B5A4478E6
Jabber.... dmjena@jabber.org
Email..... dmaus@ictsoc.de
[-- Attachment #1.2: Type: application/pgp-signature, Size: 230 bytes --]
[-- Attachment #2: Type: text/plain, Size: 201 bytes --]
_______________________________________________
Emacs-orgmode mailing list
Please use `Reply All' to send replies to the list.
Emacs-orgmode@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-orgmode
^ permalink raw reply [flat|nested] 3+ messages in thread
end of thread, other threads:[~2010-05-08 14:30 UTC | newest]
Thread overview: 3+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2010-05-07 15:36 [patch] org-wl: Code cleanup and enhancements David Maus
2010-05-08 5:33 ` Carsten Dominik
2010-05-08 12:25 ` David Maus
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).