From: Jan Malakhovski <oxij@oxij.org>
To: emacs-orgmode@gnu.org
Cc: Jan Malakhovski <oxij@oxij.org>
Subject: [PATCH 1/2] factor out date-timestamp* calculations to org-store-link-props
Date: Sun, 25 Oct 2015 13:36:32 +0000 [thread overview]
Message-ID: <1445780193-25001-2-git-send-email-oxij@oxij.org> (raw)
In-Reply-To: <1445780193-25001-1-git-send-email-oxij@oxij.org>
---
contrib/lisp/org-mew.el | 11 +----------
contrib/lisp/org-vm.el | 11 +----------
contrib/lisp/org-wl.el | 10 +---------
doc/org.texi | 4 ++--
lisp/org-gnus.el | 15 +--------------
lisp/org-mhe.el | 10 +---------
lisp/org-rmail.el | 11 +----------
lisp/org.el | 15 +++++++++++++--
8 files changed, 21 insertions(+), 66 deletions(-)
diff --git a/contrib/lisp/org-mew.el b/contrib/lisp/org-mew.el
index eb0afc0..35fdd8b 100644
--- a/contrib/lisp/org-mew.el
+++ b/contrib/lisp/org-mew.el
@@ -167,19 +167,10 @@ with \"t\" key."
(from (mew-header-get-value "From:"))
(to (mew-header-get-value "To:"))
(date (mew-header-get-value "Date:"))
- (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))))
(subject (mew-header-get-value "Subject:"))
desc link)
- (org-store-link-props :type "mew" :from from :to to
+ (org-store-link-props :type "mew" :from from :to to :date date
: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 desc (org-email-link-description))
(setq link (concat "mew:" folder-name "#" message-id))
diff --git a/contrib/lisp/org-vm.el b/contrib/lisp/org-vm.el
index 5d30f64..da242cb 100644
--- a/contrib/lisp/org-vm.el
+++ b/contrib/lisp/org-vm.el
@@ -77,12 +77,6 @@
(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)
- (date-to-time date))))
- (date-ts-ia (and date (format-time-string
- (org-time-stamp-format t t)
- (date-to-time date))))
folder desc link)
(if (vm-imap-folder-p)
(let ((spec (vm-imap-find-spec-for-buffer (current-buffer))))
@@ -95,10 +89,7 @@
(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))
+ :message-id message-id :date date)
(setq desc (org-email-link-description))
(setq link (concat (concat link-type ":") folder "#" message-id))
(org-add-link-props :link link :description desc)
diff --git a/contrib/lisp/org-wl.el b/contrib/lisp/org-wl.el
index 632c9e3..2cc333c 100644
--- a/contrib/lisp/org-wl.el
+++ b/contrib/lisp/org-wl.el
@@ -198,12 +198,6 @@ ENTITY is a 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
@@ -243,9 +237,7 @@ ENTITY is a message entity."
(setq desc (org-email-link-description))
(setq link (concat "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))
+ (org-add-link-props :date date)
(or link xref)))))))
(defun org-wl-open-nntp (path)
diff --git a/doc/org.texi b/doc/org.texi
index c1fe56e..30cc0e4 100644
--- a/doc/org.texi
+++ b/doc/org.texi
@@ -7314,8 +7314,8 @@ 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
+vm, vm-imap, wl, mh, mew, rmail, | %:type %:subject %:message-id
+gnus | %:from %:fromname %:fromaddress
| %:to %:toname %:toaddress
| %:date @r{(message date header field)}
| %:date-timestamp @r{(date as active timestamp)}
diff --git a/lisp/org-gnus.el b/lisp/org-gnus.el
index c7b46af..c1eb6c6 100644
--- a/lisp/org-gnus.el
+++ b/lisp/org-gnus.el
@@ -159,16 +159,6 @@ If `org-store-link' was called with a prefix arg the meaning of
(from (mail-header-from header))
(message-id (org-remove-angle-brackets (mail-header-id header)))
(date (org-trim (mail-header-date header)))
- (date-ts (and date
- (ignore-errors
- (format-time-string
- (org-time-stamp-format t)
- (date-to-time date)))))
- (date-ts-ia (and date
- (ignore-errors
- (format-time-string
- (org-time-stamp-format t t)
- (date-to-time date)))))
(subject (copy-sequence (mail-header-subject header)))
(to (cdr (assq 'To (mail-header-extra header))))
newsgroups x-no-archive desc link)
@@ -188,11 +178,8 @@ If `org-store-link' was called with a prefix arg the meaning of
(setq to (or to (gnus-fetch-original-field "To"))
newsgroups (gnus-fetch-original-field "Newsgroups")
x-no-archive (gnus-fetch-original-field "x-no-archive")))
- (org-store-link-props :type "gnus" :from from :subject subject
+ (org-store-link-props :type "gnus" :from from :date date :subject subject
:message-id message-id :group group :to to)
- (when date
- (org-add-link-props :date date :date-timestamp date-ts
- :date-timestamp-inactive date-ts-ia))
(setq desc (org-email-link-description)
link (org-gnus-article-link
group newsgroups message-id x-no-archive))
diff --git a/lisp/org-mhe.el b/lisp/org-mhe.el
index e184440..3fcbc46 100644
--- a/lisp/org-mhe.el
+++ b/lisp/org-mhe.el
@@ -88,17 +88,9 @@ supported by MH-E."
(message-id (org-mhe-get-header "Message-Id:"))
(subject (org-mhe-get-header "Subject:"))
(date (org-mhe-get-header "Date:"))
- (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))))
link desc)
- (org-store-link-props :type "mh" :from from :to to
+ (org-store-link-props :type "mh" :from from :to to :date date
: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 desc (org-email-link-description))
(setq link (concat "mhe:" (org-mhe-get-message-real-folder) "#"
(org-remove-angle-brackets message-id)))
diff --git a/lisp/org-rmail.el b/lisp/org-rmail.el
index af47e0f..4732f51 100644
--- a/lisp/org-rmail.el
+++ b/lisp/org-rmail.el
@@ -65,19 +65,10 @@
(to (mail-fetch-field "to"))
(subject (mail-fetch-field "subject"))
(date (mail-fetch-field "date"))
- (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)
(org-store-link-props
- :type "rmail" :from from :to to
+ :type "rmail" :from from :to to :date date
: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 desc (org-email-link-description))
(setq link (concat "rmail:" folder "#" message-id))
diff --git a/lisp/org.el b/lisp/org.el
index 4e4f001..5ab50f3 100755
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -9960,7 +9960,7 @@ active region."
(car org-stored-links))))))
(defun org-store-link-props (&rest plist)
- "Store link properties, extract names and addresses."
+ "Store link properties, extract names, addresses and dates."
(let (x adr)
(when (setq x (plist-get plist :from))
(setq adr (mail-extract-address-components x))
@@ -9969,7 +9969,18 @@ active region."
(when (setq x (plist-get plist :to))
(setq adr (mail-extract-address-components x))
(setq plist (plist-put plist :toname (car adr)))
- (setq plist (plist-put plist :toaddress (nth 1 adr)))))
+ (setq plist (plist-put plist :toaddress (nth 1 adr))))
+ (when (setq x (plist-get plist :date))
+ (setq plist (plist-put plist :date-timestamp
+ (ignore-errors
+ (format-time-string
+ (org-time-stamp-format t)
+ (date-to-time x)))))
+ (setq plist (plist-put plist :date-timestamp-inactive
+ (ignore-errors
+ (format-time-string
+ (org-time-stamp-format t t)
+ (date-to-time x)))))))
(let ((from (plist-get plist :from))
(to (plist-get plist :to)))
(when (and from to org-from-is-user-regexp)
--
2.5.3
next prev parent reply other threads:[~2015-10-25 13:36 UTC|newest]
Thread overview: 5+ messages / expand[flat|nested] mbox.gz Atom feed top
2015-10-25 13:36 [PATCH] remove some copy-paste and add date support to org-notmuch-store-link Jan Malakhovski
2015-10-25 13:36 ` Jan Malakhovski [this message]
2015-10-25 13:36 ` [PATCH 2/2] org-notmuch: " Jan Malakhovski
-- strict thread matches above, loose matches on Subject: below --
2015-12-27 14:54 [PATCH v3 part2 0/2] date-timestamp* calculations Jan Malakhovski
2015-12-27 14:54 ` [PATCH 1/2] factor out date-timestamp* calculations to org-store-link-props Jan Malakhovski
2015-12-29 20:24 ` Nicolas Goaziou
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.orgmode.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=1445780193-25001-2-git-send-email-oxij@oxij.org \
--to=oxij@oxij.org \
--cc=emacs-orgmode@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
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).