view lisp/org/org-mac-message.el @ 103344:d04aeff22966

2009-06-08 Adrian Robert <Adrian.B.Robert@gmail.com> * nsterm.m (ns_use_system_highlight_color): Drop, unused. 2009-06-08 Adrian Robert <Adrian.B.Robert@gmail.com> Changes to support :script/:lang/:otf in NS font driver. * nsfont.m (nsfont_escape_name, nsfont_unescape_name) (nsfont_get_family, nsfont_char_width): Rename to ns_ prefix to indicate not part of font driver interface, and change callers. (ns_get_family): Remove pointless null check. (nsfont_spec_to_traits, nsfont_fmember_to_entity): Replace with ns_spec_to_descriptor, ns_descriptor_to_entity. (nsfont_trait_distance, nsfont_make_fontset_for_font): Remove. (ns_attribute_value, ns_attribute_fvalue, ns_has_attribute) (ns_spec_to_descriptor, ns_descriptor_to_entity) (ns_charset_covers, ns_lang_to_script, ns_otf_to_script) (ns_get_req_script, ns_accumulate_script_ranges) (ns_script_to_charset, ns_get_covering_families, ns_findfonts): New functions. (nsfont_list, nsfont_match): Use ns_findfonts. (nsfont_open): Use font descriptor instead of traits. (nsfont_draw): Handle "automatic" (lookup-table) compositions. (dump_glyphstring): Rename to ns_dump_glyphstring. * nsfns.m (Fns_popup_font_panel): Use shared font manager. * fontset.c (fontset_from_font): Remove NS-specific code. 2009-06-08 Peter Jones <pjones@pmade.com> (tiny change) * nsterm.m (ns_draw_window_cursor): Respect cursor_type for nonactive windows. 2009-06-08 Felix Mueller <felix@enqueue.eu> (tiny change) * nsterm.m (ns_init_paths): Append path separator to INFOPATH variable.
author Adrian Robert <Adrian.B.Robert@gmail.com>
date Mon, 08 Jun 2009 04:34:54 +0000
parents 6d71fc980cde
children ac1a55cc2c38
line wrap: on
line source

;;; org-mac-message.el --- Support for links to Apple Mail messages from within Org-mode

;; Copyright (C) 2008, 2009 Free Software Foundation, Inc.

;; Author: John Wiegley <johnw@gnu.org>
;; Version: 6.21b
;; Keywords: outlines, hypermedia, calendar, wp

;; This file is 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/>.

;;; Commentary:
;; This file implements links to Apple Mail messages from within Org-mode.
;; Org-mode does not load this module by default - if you would actually like
;; this to happen then configure the variable `org-modules'.

;;; Code:

(require 'org)

(org-add-link-type "message" 'org-mac-message-open)

;; In mac.c, removed in Emacs 23.
(declare-function do-applescript "org-mac-message" (script))
(unless (fboundp 'do-applescript)
  ;; Need to fake this using shell-command-to-string
  (defun do-applescript (script)
    (let (start cmd return)
      (while (string-match "\n" script)
	(setq script (replace-match "\r" t t script)))
      (while (string-match "'" script start)
	(setq start (+ 2 (match-beginning 0))
	      script (replace-match "\\'" t t script)))
      (setq cmd (concat "osascript -e '" script "'"))
      (setq return (shell-command-to-string cmd))
      (concat "\"" (org-trim return) "\""))))

(defun org-mac-message-open (message-id)
  "Visit the message with the given MESSAGE-ID.
This will use the command `open' with the message URL."
  (start-process (concat "open message:" message-id) nil
		 "open" (concat "message://<" (substring message-id 2) ">")))

(defun org-mac-message-insert-link ()
  "Insert a link to the messages currently selected in Apple Mail.
This will use applescript to get the message-id and the subject of the
active mail in AppleMail and make a link out of it."
  (interactive)
  (insert (org-mac-message-get-link)))

(defun org-mac-message-get-link ()
  "Insert a link to the messages currently selected in Apple Mail.
This will use applescript to get the message-id and the subject of the
active mail in AppleMail and make a link out of it."
  (let ((subject (do-applescript "tell application \"Mail\"
	set theMessages to selection
	subject of beginning of theMessages
end tell"))
	(message-id (do-applescript "tell application \"Mail\"
	set theMessages to selection
	message id of beginning of theMessages
end tell")))
    (org-make-link-string
     (concat "message://"
	     (substring message-id 1 (1- (length message-id))))
     (substring subject 1 (1- (length subject))))))

(provide 'org-mac-message)

;; arch-tag: 3806d0c1-abe1-4db6-9c31-f3ed7d4a9b32

;;; org-mac-message.el ends here