Переглянути джерело

Import org-contacts-wl in contrib

* org-contacts-wl.el: New file.

Signed-off-by: Julien Danjou <julien@danjou.info>
Michael Markert 14 роки тому
батько
коміт
f0f103394c
1 змінених файлів з 56 додано та 0 видалено
  1. 56 0
      contrib/lisp/org-contacts-wl.el

+ 56 - 0
contrib/lisp/org-contacts-wl.el

@@ -0,0 +1,56 @@
+;;; org-contacts-wl.el --- Org-contacts support for Wanderlust
+
+;; Copyright (C) 2011 Michael Markert <markert.michael@googlemail.com>
+
+;; Author: Michael Markert <markert.michael@googlemail.com>
+;;
+;; This file is NOT part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(require 'std11)
+(require 'elmo)
+(require 'wl-address)
+(require 'wl-summary)
+
+(defun wl-get-from-header-content ()
+  (save-excursion
+    (set-buffer (org-capture-get :original-buffer))
+    (cond
+     ((eq major-mode 'wl-summary-mode) (when wl-summary-buffer-elmo-folder
+                                         (elmo-message-field
+                                          wl-summary-buffer-elmo-folder
+                                          (wl-summary-message-number)
+                                          'from)))
+     ((eq major-mode 'mime-view-mode) (std11-narrow-to-header)
+                                      (prog1
+                                          (std11-fetch-field "From")
+                                        (widen))))))
+
+(defun org-contacts-template-wl-name (&optional return-value)
+  (let ((from (wl-get-from-header-content)))
+    (or (and from (wl-address-header-extract-realname from))
+       return-value
+       "%^{Name}")))
+
+(defun org-contacts-template-wl-email (&optional return-value)
+  (let ((from (wl-get-from-header-content)))
+    (or (and from (wl-address-header-extract-address from))
+       return-value
+       (concat "%^{" org-contacts-email-property "}p"))))
+
+(provide 'org-contacts-wl)