X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/0ee81a0ce066375eac701c06cdfbdebefe594fdc..acaf905b1130aae80fa59d2c861ffd4c8eb75486:/lisp/org/org-wl.el diff --git a/lisp/org/org-wl.el b/lisp/org/org-wl.el index 4d2f8ec128..6d2370671b 100644 --- a/lisp/org/org-wl.el +++ b/lisp/org/org-wl.el @@ -1,13 +1,11 @@ ;;; org-wl.el --- Support for links to Wanderlust messages from within Org-mode -;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 -;; Free Software Foundation, Inc. +;; Copyright (C) 2004-2012 Free Software Foundation, Inc. ;; Author: Tokuya Kameshima ;; David Maus ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -84,6 +82,8 @@ googlegroups otherwise." (declare-function wl-summary-buffer-msgdb "ext:wl-folder" () t) (declare-function wl-summary-jump-to-msg-by-message-id "ext:wl-summary" (&optional id)) +(declare-function wl-summary-jump-to-msg "ext:wl-summary" + (&optional number beg end)) (declare-function wl-summary-line-from "ext:wl-summary" ()) (declare-function wl-summary-line-subject "ext:wl-summary" ()) (declare-function wl-summary-message-number "ext:wl-summary" ()) @@ -100,6 +100,7 @@ googlegroups otherwise." (defvar wl-summary-buffer-folder-name) (defvar wl-folder-group-regexp) (defvar wl-auto-check-folder-name) +(defvar elmo-nntp-default-server) (defconst org-wl-folder-types '(("%" . imap) ("-" . nntp) ("+" . mh) ("=" . spool) @@ -116,7 +117,7 @@ googlegroups otherwise." (defun org-wl-folder-type (folder) "Return symbol that indicates the type of FOLDER. FOLDER is the wanderlust folder name. The first character of the -folder name determines the the folder type." +folder name determines the folder type." (let* ((indicator (substring folder 0 1)) (type (cdr (assoc indicator org-wl-folder-types)))) ;; maybe access or file folder @@ -137,18 +138,19 @@ folder name determines the the folder type." "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))) + (let ((content (elmo-message-entity-field entity field 'string))) (if (listp content) (car content) content))) (defun org-wl-store-link () "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))) + (unless (eobp) + (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." @@ -189,10 +191,19 @@ ENTITY is a message entity." msgnum (wl-summary-buffer-msgdb)))) (message-id (org-wl-message-field 'message-id wl-message-entity)) + (message-id-no-brackets + (org-remove-angle-brackets message-id)) (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)) + (date (org-wl-message-field 'date wl-message-entity)) + (date-ts (and date (format-time-string + (org-time-stamp-format t) + (date-to-time date)))) + (date-ts-ia (and date (format-time-string + (org-time-stamp-format t t) + (date-to-time date)))) desc link) ;; remove text properties of subject string to avoid possible bug @@ -212,6 +223,7 @@ ENTITY is a message entity." 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 + :message-id-no-brackets message-id-no-brackets :subject subject)) ((and (eq folder-type 'nntp) org-wl-nntp-prefer-web-links) (setq link @@ -222,16 +234,35 @@ ENTITY is a message entity." (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 + :message-id-no-brackets message-id-no-brackets :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)) + :subject subject :message-id message-id + :message-id-no-brackets message-id-no-brackets) (setq desc (org-email-link-description)) - (setq link (org-make-link "wl:" folder-name "#" message-id)) + (setq link (org-make-link "wl:" folder-name "#" message-id-no-brackets)) (org-add-link-props :link link :description desc))) + (when date + (org-add-link-props :date date :date-timestamp date-ts + :date-timestamp-inactive date-ts-ia)) (or link xref))))))) +(defun org-wl-open-nntp (path) + "Follow the nntp: link specified by PATH." + (let* ((spec (split-string path "/")) + (server (split-string (nth 2 spec) "@")) + (group (nth 3 spec)) + (article (nth 4 spec))) + (org-wl-open + (concat "-" group ":" (if (cdr server) + (car (split-string (car server) ":")) + "") + (if (string= elmo-nntp-default-server (nth 2 spec)) + "" + (concat "@" (or (cdr server) (car server)))) + (if article (concat "#" article) ""))))) + (defun org-wl-open (path) "Follow the WL message link specified by PATH. When called with one prefix, open message in namazu search folder @@ -267,12 +298,14 @@ for namazu index." ;; beginning of the current line. So, restore the point ;; in the old buffer. (goto-char old-point)) - (and article (wl-summary-jump-to-msg-by-message-id (org-add-angle-brackets - article)) + (when article + (if (org-string-match-p "@" article) + (wl-summary-jump-to-msg-by-message-id (org-add-angle-brackets + article)) + (or (wl-summary-jump-to-msg (string-to-number article)) + (error "No such message: %s" article))) (wl-summary-redisplay)))))) (provide 'org-wl) -;; arch-tag: 29b75a0f-ef2e-430b-8abc-acff75bde54a - ;;; org-wl.el ends here