mirror of
https://git.savannah.gnu.org/git/emacs/org-mode.git
synced 2024-08-26 16:02:52 +00:00
Merge branch 'split-out-linking-code'
Conflicts: ChangeLog
This commit is contained in:
commit
430adefb49
33
ChangeLog
33
ChangeLog
|
@ -1,3 +1,4 @@
|
|||
|
||||
2008-03-14 Bastien Guerry <bzg@altern.org>
|
||||
|
||||
* org-publish.el (org-publish-get-base-files-1): New function.
|
||||
|
@ -5,6 +6,38 @@
|
|||
(org-publish-temp-files): New variable.
|
||||
Don't require 'dired-aux anymore.
|
||||
|
||||
2008-03-15 Carsten Dominik <dominik@science.uva.nl>
|
||||
|
||||
* org-info.el: New file.
|
||||
(org-info-follow-link): Renamed from `org-follow-info-link'.
|
||||
|
||||
* org-gnus.el: New file.
|
||||
(org-gnus-follow-link): Renamed from `org-flow-gnus-link'.
|
||||
|
||||
* org-mhe.el: New file.
|
||||
(org-mhe-follow-link): Renamed from `org-follow-mhe-link'
|
||||
|
||||
* org-wl.el: New file.
|
||||
(org-wl-follow-link): Renamed from `org-follow-wl-link'.
|
||||
|
||||
2008-03-14 Carsten Dominik <dominik@science.uva.nl>
|
||||
|
||||
* org-vm.el: New file.
|
||||
(org-vm-follow-link): Renamed from `org-follow-vm-link'.
|
||||
|
||||
* org-bbdb.el: New file.
|
||||
|
||||
* org-rmail.el: New file.
|
||||
(org-rmail-follow-link): Renamed from `org-follow-rmail-link'.
|
||||
|
||||
* org.el (org-export-as-html): Use `org-link-protocols' to
|
||||
retrieve the export form of the link.
|
||||
(org-add-link-type): Final parameter renamed from PUBLISH. Better
|
||||
documentation of how it is to be used. Avoid double entries for
|
||||
the same link type.
|
||||
(org-add-link-props): New function.
|
||||
>>>>>>> split-out-linking-code:ChangeLog
|
||||
|
||||
2008-03-14 Glenn Morris <rmg@gnu.org>
|
||||
|
||||
* org-publish.el (declare-function): Add compatibility stub.
|
||||
|
|
3
Makefile
3
Makefile
|
@ -61,7 +61,8 @@ CP = cp -p
|
|||
|
||||
# The following variables need to be defined by the maintainer
|
||||
LISPFILES0 = org.el org-publish.el org-mouse.el org-export-latex.el \
|
||||
org-mac-message.el org-irc.el
|
||||
org-bbdb.el org-gnus.el org-info.el org-irc.el \
|
||||
org-mac-message.el org-mhe.el org-rmail.el org-vm.el org-wl.el
|
||||
LISPFILES = $(LISPFILES0) org-install.el
|
||||
ELCFILES = $(LISPFILES:.el=.elc)
|
||||
DOCFILES = org.texi org.pdf org
|
||||
|
|
93
org-bbdb.el
Normal file
93
org-bbdb.el
Normal file
|
@ -0,0 +1,93 @@
|
|||
;;; org-bbdb.el - Support for links to bbdb entries in Org-mode
|
||||
|
||||
;; Copyright (C) 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Carsten Dominik <carsten at orgmode dot org>
|
||||
;; Keywords: outlines, hypermedia, calendar, wp
|
||||
;; Homepage: http://orgmode.org
|
||||
;; Version: 1.0
|
||||
;;
|
||||
;; 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, 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; see the file COPYING. If not, write to the
|
||||
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
||||
;; Boston, MA 02110-1301, USA.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;;; Commentary:
|
||||
|
||||
;; This file implements links to BBDB database entries for Org-mode.
|
||||
;; Org-mode loads this module by default - if this is not what you want,
|
||||
;; configure the variable `org-modules'.
|
||||
|
||||
(require 'org)
|
||||
|
||||
;; Declare external functions and variables
|
||||
(declare-function bbdb "ext:bbdb-com" (string elidep))
|
||||
(declare-function bbdb-company "ext:bbdb-com" (string elidep))
|
||||
(declare-function bbdb-current-record "ext:bbdb-com"
|
||||
(&optional planning-on-modifying))
|
||||
(declare-function bbdb-name "ext:bbdb-com" (string elidep))
|
||||
(declare-function bbdb-record-getprop "ext:bbdb" (record property))
|
||||
(declare-function bbdb-record-name "ext:bbdb" (record))
|
||||
|
||||
;; Install the link type
|
||||
(org-add-link-type "bbdb" 'org-bbdb-open 'org-bbdb-export)
|
||||
(add-hook 'org-store-link-functions 'org-bbdb-store-link)
|
||||
|
||||
;; Implementation
|
||||
(defun org-bbdb-store-link ()
|
||||
"Store a link to a README file."
|
||||
(when (eq major-mode 'bbdb-mode)
|
||||
;; This is BBDB, we make this link!
|
||||
(let* ((name (bbdb-record-name (bbdb-current-record)))
|
||||
(company (bbdb-record-getprop (bbdb-current-record) 'company))
|
||||
(link (org-make-link "bbdb:" name)))
|
||||
(org-store-link-props :type "bbdb" :name name :company company
|
||||
:link link :description name))))
|
||||
|
||||
(defun org-bbdb-export (path desc format)
|
||||
"Create the exprt verison of a bbdb link."
|
||||
(cond
|
||||
((eq format 'html) (format "<i>%s</i>" (or desc path)))
|
||||
((eq format 'latex) (format "\\textit{%s}" (or desc path)))
|
||||
(t (or desc path))))
|
||||
|
||||
(defun org-bbdb-open (name)
|
||||
"Follow a BBDB link to NAME."
|
||||
(require 'bbdb)
|
||||
(let ((inhibit-redisplay (not debug-on-error))
|
||||
(bbdb-electric-p nil))
|
||||
(catch 'exit
|
||||
;; Exact match on name
|
||||
(bbdb-name (concat "\\`" name "\\'") nil)
|
||||
(if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
|
||||
;; Exact match on name
|
||||
(bbdb-company (concat "\\`" name "\\'") nil)
|
||||
(if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
|
||||
;; Partial match on name
|
||||
(bbdb-name name nil)
|
||||
(if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
|
||||
;; Partial match on company
|
||||
(bbdb-company name nil)
|
||||
(if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
|
||||
;; General match including network address and notes
|
||||
(bbdb name nil)
|
||||
(when (= 0 (buffer-size (get-buffer "*BBDB*")))
|
||||
(delete-window (get-buffer-window "*BBDB*"))
|
||||
(error "No matching BBDB record")))))
|
||||
|
||||
(provide 'org-bbdb)
|
||||
|
||||
;;; org-bbdb.el ends here
|
125
org-gnus.el
Normal file
125
org-gnus.el
Normal file
|
@ -0,0 +1,125 @@
|
|||
;;; org-gnus.el - Support for links to GNUS groups and messages in Org-mode
|
||||
|
||||
;; Copyright (C) 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Carsten Dominik <carsten at orgmode dot org>
|
||||
;; Keywords: outlines, hypermedia, calendar, wp
|
||||
;; Homepage: http://orgmode.org
|
||||
;; Version: 1.0
|
||||
;;
|
||||
;; 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, 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; see the file COPYING. If not, write to the
|
||||
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
||||
;; Boston, MA 02110-1301, USA.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;;; Commentary:
|
||||
|
||||
;; This file implements links to GNUS groups and messages for Org-mode.
|
||||
;; Org-mode loads this module by default - if this is not what you want,
|
||||
;; configure the variable `org-modules'.
|
||||
|
||||
(require 'org)
|
||||
(eval-when-compile
|
||||
(require 'gnus-sum))
|
||||
|
||||
;; Customization variables
|
||||
|
||||
(defcustom org-usenet-links-prefer-google nil
|
||||
"Non-nil means, `org-store-link' will create web links to Google groups.
|
||||
When nil, Gnus will be used for such links.
|
||||
Using a prefix arg to the command \\[org-store-link] (`org-store-link')
|
||||
negates this setting for the duration of the command."
|
||||
:group 'org-link-store
|
||||
:type 'boolean)
|
||||
|
||||
;; Declare external functions and variables
|
||||
(declare-function gnus-article-show-summary "gnus-art" ())
|
||||
(declare-function gnus-summary-last-subject "gnus-sum" ())
|
||||
(defvar gnus-other-frame-object)
|
||||
(defvar gnus-group-name)
|
||||
(defvar gnus-article-current)
|
||||
|
||||
;; Install the link type
|
||||
(org-add-link-type "gnus" 'org-gnus-open)
|
||||
(add-hook 'org-store-link-functions 'org-gnus-store-link)
|
||||
|
||||
;; Implementation
|
||||
(defun org-gnus-store-link ()
|
||||
"Store a link to an GNUS folder or message."
|
||||
(cond
|
||||
((eq major-mode 'gnus-group-mode)
|
||||
(let ((group (cond ((fboundp 'gnus-group-group-name) ; depending on Gnus
|
||||
(gnus-group-group-name)) ; version
|
||||
((fboundp 'gnus-group-name)
|
||||
(gnus-group-name))
|
||||
(t "???")))
|
||||
desc link)
|
||||
(unless group (error "Not on a group"))
|
||||
(org-store-link-props :type "gnus" :group group)
|
||||
(setq desc (concat
|
||||
(if (org-xor current-prefix-arg
|
||||
org-usenet-links-prefer-google)
|
||||
"http://groups.google.com/groups?group="
|
||||
"gnus:")
|
||||
group)
|
||||
link (org-make-link desc))
|
||||
(org-add-link-props :link link :description desc)))
|
||||
|
||||
((memq major-mode '(gnus-summary-mode gnus-article-mode))
|
||||
(and (eq major-mode 'gnus-article-mode) (gnus-article-show-summary))
|
||||
(let* ((group gnus-newsgroup-name)
|
||||
(article (gnus-summary-article-number))
|
||||
(header (gnus-summary-article-header article))
|
||||
(from (mail-header-from header))
|
||||
(message-id (mail-header-id header))
|
||||
(date (mail-header-date header))
|
||||
(subject (gnus-summary-subject-string))
|
||||
desc link)
|
||||
(org-store-link-props :type "gnus" :from from :subject subject
|
||||
:message-id message-id :group group)
|
||||
(setq desc (org-email-link-description))
|
||||
(if (org-xor current-prefix-arg org-usenet-links-prefer-google)
|
||||
(setq link
|
||||
(concat
|
||||
desc "\n "
|
||||
(format "http://groups.google.com/groups?as_umsgid=%s"
|
||||
(org-fixup-message-id-for-http message-id))))
|
||||
(setq link (org-make-link "gnus:" group
|
||||
"#" (number-to-string article))))
|
||||
(org-add-link-props :link link :description desc)))))
|
||||
|
||||
(defun org-gnus-open (path)
|
||||
"Follow an GNUS message or folder link."
|
||||
(let (group article)
|
||||
(if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
|
||||
(error "Error in Gnus link"))
|
||||
(setq group (match-string 1 path)
|
||||
article (match-string 3 path))
|
||||
(org-gnus-follow-link group article)))
|
||||
|
||||
(defun org-gnus-follow-link (&optional group article)
|
||||
"Follow a Gnus link to GROUP and ARTICLE."
|
||||
(require 'gnus)
|
||||
(funcall (cdr (assq 'gnus org-link-frame-setup)))
|
||||
(if gnus-other-frame-object (select-frame gnus-other-frame-object))
|
||||
(cond ((and group article)
|
||||
(gnus-group-read-group 1 nil group)
|
||||
(gnus-summary-goto-article (string-to-number article) nil t))
|
||||
(group (gnus-group-jump-to-group group))))
|
||||
|
||||
(provide 'org-gnus)
|
||||
|
||||
;;; org-gnus.el ends here
|
78
org-info.el
Normal file
78
org-info.el
Normal file
|
@ -0,0 +1,78 @@
|
|||
;;; org-info.el - Support for links to Info nodes in Org-mode
|
||||
|
||||
;; Copyright (C) 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Carsten Dominik <carsten at orgmode dot org>
|
||||
;; Keywords: outlines, hypermedia, calendar, wp
|
||||
;; Homepage: http://orgmode.org
|
||||
;; Version: 1.0
|
||||
;;
|
||||
;; 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, 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; see the file COPYING. If not, write to the
|
||||
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
||||
;; Boston, MA 02110-1301, USA.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;;; Commentary:
|
||||
|
||||
;; This file implements links to Info nodes for Org-mode.
|
||||
;; Org-mode loads this module by default - if this is not what you want,
|
||||
;; configure the variable `org-modules'.
|
||||
|
||||
(require 'org)
|
||||
|
||||
;; Declare external functions and variables
|
||||
(declare-function Info-find-node "info" (filename nodename
|
||||
&optional no-going-back))
|
||||
(defvar Info-current-file)
|
||||
(defvar Info-current-node)
|
||||
|
||||
;; Install the link type
|
||||
(org-add-link-type "info" 'org-info-open)
|
||||
(add-hook 'org-store-link-functions 'org-info-store-link)
|
||||
|
||||
;; Implementation
|
||||
(defun org-info-store-link ()
|
||||
"Store a link to an INFO folder or message."
|
||||
(when (eq major-mode 'Info-mode)
|
||||
(let (link desc)
|
||||
(setq link (org-make-link "info:"
|
||||
(file-name-nondirectory Info-current-file)
|
||||
":" Info-current-node))
|
||||
(setq desc (concat (file-name-nondirectory Info-current-file)
|
||||
":" Info-current-node))
|
||||
(org-store-link-props :type "info" :file Info-current-file
|
||||
:node Info-current-node
|
||||
:link link :desc desc))))
|
||||
|
||||
(defun org-info-open (path)
|
||||
"Follow an INFO message link."
|
||||
(org-info-follow-link path))
|
||||
|
||||
|
||||
(defun org-info-follow-link (name)
|
||||
"Follow an info file & node link to NAME."
|
||||
(if (or (string-match "\\(.*\\)::?\\(.*\\)" name)
|
||||
(string-match "\\(.*\\)" name))
|
||||
(progn
|
||||
(require 'info)
|
||||
(if (match-string 2 name) ; If there isn't a node, choose "Top"
|
||||
(Info-find-node (match-string 1 name) (match-string 2 name))
|
||||
(Info-find-node (match-string 1 name) "Top")))
|
||||
(message "Could not open: %s" name)))
|
||||
|
||||
(provide 'org-info)
|
||||
|
||||
;;; org-info.el ends here
|
210
org-mhe.el
Normal file
210
org-mhe.el
Normal file
|
@ -0,0 +1,210 @@
|
|||
;;; org-mhe.el - Support for links to MHE messages in Org-mode
|
||||
|
||||
;; Copyright (C) 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Carsten Dominik <carsten at orgmode dot org>
|
||||
;; Keywords: outlines, hypermedia, calendar, wp
|
||||
;; Homepage: http://orgmode.org
|
||||
;; Version: 1.0
|
||||
;;
|
||||
;; 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, 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; see the file COPYING. If not, write to the
|
||||
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
||||
;; Boston, MA 02110-1301, USA.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;;; Commentary:
|
||||
|
||||
;; This file implements links to MHE messages for Org-mode.
|
||||
;; Org-mode loads this module by default - if this is not what you want,
|
||||
;; configure the variable `org-modules'.
|
||||
|
||||
(require 'org)
|
||||
|
||||
;; Customization variables
|
||||
(defcustom org-mhe-search-all-folders nil
|
||||
"Non-nil means, that the search for the mh-message will be extended to
|
||||
all folders if the message cannot be found in the folder given in the link.
|
||||
Searching all folders is very efficient with one of the search engines
|
||||
supported by MH-E, but will be slow with pick."
|
||||
:group 'org-link-follow
|
||||
:type 'boolean)
|
||||
|
||||
;; Declare external functions and variables
|
||||
(declare-function mh-display-msg "mh-show" (msg-num folder-name))
|
||||
(declare-function mh-find-path "mh-utils" ())
|
||||
(declare-function mh-get-header-field "mh-utils" (field))
|
||||
(declare-function mh-get-msg-num "mh-utils" (error-if-no-message))
|
||||
(declare-function mh-header-display "mh-show" ())
|
||||
(declare-function mh-index-previous-folder "mh-search" ())
|
||||
(declare-function mh-normalize-folder-name "mh-utils"
|
||||
(folder &optional empty-string-okay dont-remove-trailing-slash
|
||||
return-nil-if-folder-empty))
|
||||
(declare-function mh-search "mh-search"
|
||||
(folder search-regexp &optional redo-search-flag
|
||||
window-config))
|
||||
(declare-function mh-search-choose "mh-search" (&optional searcher))
|
||||
(declare-function mh-show "mh-show" (&optional message redisplay-flag))
|
||||
(declare-function mh-show-buffer-message-number "mh-comp" (&optional buffer))
|
||||
(declare-function mh-show-header-display "mh-show" t t)
|
||||
(declare-function mh-show-msg "mh-show" (msg))
|
||||
(declare-function mh-show-show "mh-show" t t)
|
||||
(declare-function mh-visit-folder "mh-folder" (folder &optional
|
||||
range index-data))
|
||||
(defvar mh-progs)
|
||||
(defvar mh-current-folder)
|
||||
(defvar mh-show-folder-buffer)
|
||||
(defvar mh-index-folder)
|
||||
(defvar mh-searcher)
|
||||
|
||||
;; Install the link type
|
||||
(org-add-link-type "mhe" 'org-mhe-open)
|
||||
(add-hook 'org-store-link-functions 'org-mhe-store-link)
|
||||
|
||||
;; Implementation
|
||||
(defun org-mhe-store-link ()
|
||||
"Store a link to an MHE folder or message."
|
||||
(when (or (equal major-mode 'mh-folder-mode)
|
||||
(equal major-mode 'mh-show-mode))
|
||||
(let ((from (org-mhe-get-header "From:"))
|
||||
(to (org-mhe-get-header "To:"))
|
||||
(message-id (org-mhe-get-header "Message-Id:"))
|
||||
(subject (org-mhe-get-header "Subject:"))
|
||||
link desc)
|
||||
(org-store-link-props :type "mh" :from from :to to
|
||||
:subject subject :message-id message-id)
|
||||
(setq desc (org-email-link-description))
|
||||
(setq link (org-make-link "mhe:" (org-mhe-get-message-real-folder) "#"
|
||||
(org-remove-angle-brackets message-id)))
|
||||
(org-add-link-props :link link :description desc))))
|
||||
|
||||
(defun org-mhe-open (path)
|
||||
"Follow an MHE message link."
|
||||
(let (folder article)
|
||||
(if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
|
||||
(error "Error in MHE link"))
|
||||
(setq folder (match-string 1 path)
|
||||
article (match-string 3 path))
|
||||
(org-mhe-follow-link folder article)))
|
||||
|
||||
;;; mh-e integration based on planner-mode
|
||||
(defun org-mhe-get-message-real-folder ()
|
||||
"Return the name of the current message real folder, so if you use
|
||||
sequences, it will now work."
|
||||
(save-excursion
|
||||
(let* ((folder
|
||||
(if (equal major-mode 'mh-folder-mode)
|
||||
mh-current-folder
|
||||
;; Refer to the show buffer
|
||||
mh-show-folder-buffer))
|
||||
(end-index
|
||||
(if (boundp 'mh-index-folder)
|
||||
(min (length mh-index-folder) (length folder))))
|
||||
)
|
||||
;; a simple test on mh-index-data does not work, because
|
||||
;; mh-index-data is always nil in a show buffer.
|
||||
(if (and (boundp 'mh-index-folder)
|
||||
(string= mh-index-folder (substring folder 0 end-index)))
|
||||
(if (equal major-mode 'mh-show-mode)
|
||||
(save-window-excursion
|
||||
(let (pop-up-frames)
|
||||
(when (buffer-live-p (get-buffer folder))
|
||||
(progn
|
||||
(pop-to-buffer folder)
|
||||
(org-mhe-get-message-folder-from-index)
|
||||
)
|
||||
)))
|
||||
(org-mhe-get-message-folder-from-index)
|
||||
)
|
||||
folder
|
||||
)
|
||||
)))
|
||||
|
||||
(defun org-mhe-get-message-folder-from-index ()
|
||||
"Returns the name of the message folder in a index folder buffer."
|
||||
(save-excursion
|
||||
(mh-index-previous-folder)
|
||||
(re-search-forward "^\\(+.*\\)$" nil t)
|
||||
(message "%s" (match-string 1))))
|
||||
|
||||
(defun org-mhe-get-message-folder ()
|
||||
"Return the name of the current message folder. Be careful if you
|
||||
use sequences."
|
||||
(save-excursion
|
||||
(if (equal major-mode 'mh-folder-mode)
|
||||
mh-current-folder
|
||||
;; Refer to the show buffer
|
||||
mh-show-folder-buffer)))
|
||||
|
||||
(defun org-mhe-get-message-num ()
|
||||
"Return the number of the current message. Be careful if you
|
||||
use sequences."
|
||||
(save-excursion
|
||||
(if (equal major-mode 'mh-folder-mode)
|
||||
(mh-get-msg-num nil)
|
||||
;; Refer to the show buffer
|
||||
(mh-show-buffer-message-number))))
|
||||
|
||||
(defun org-mhe-get-header (header)
|
||||
"Return a header of the message in folder mode. This will create a
|
||||
show buffer for the corresponding message. If you have a more clever
|
||||
idea..."
|
||||
(let* ((folder (org-mhe-get-message-folder))
|
||||
(num (org-mhe-get-message-num))
|
||||
(buffer (get-buffer-create (concat "show-" folder)))
|
||||
(header-field))
|
||||
(with-current-buffer buffer
|
||||
(mh-display-msg num folder)
|
||||
(if (equal major-mode 'mh-folder-mode)
|
||||
(mh-header-display)
|
||||
(mh-show-header-display))
|
||||
(set-buffer buffer)
|
||||
(setq header-field (mh-get-header-field header))
|
||||
(if (equal major-mode 'mh-folder-mode)
|
||||
(mh-show)
|
||||
(mh-show-show))
|
||||
header-field)))
|
||||
|
||||
(defun org-mhe-follow-link (folder article)
|
||||
"Follow an MHE link to FOLDER and ARTICLE.
|
||||
If ARTICLE is nil FOLDER is shown. If the configuration variable
|
||||
`org-mhe-search-all-folders' is t and `mh-searcher' is pick,
|
||||
ARTICLE is searched in all folders. Indexed searches (swish++,
|
||||
namazu, and others supported by MH-E) will always search in all
|
||||
folders."
|
||||
(require 'mh-e)
|
||||
(require 'mh-search)
|
||||
(require 'mh-utils)
|
||||
(mh-find-path)
|
||||
(if (not article)
|
||||
(mh-visit-folder (mh-normalize-folder-name folder))
|
||||
(setq article (org-add-angle-brackets article))
|
||||
(mh-search-choose)
|
||||
(if (equal mh-searcher 'pick)
|
||||
(progn
|
||||
(mh-search folder (list "--message-id" article))
|
||||
(when (and org-mhe-search-all-folders
|
||||
(not (org-mhe-get-message-real-folder)))
|
||||
(kill-this-buffer)
|
||||
(mh-search "+" (list "--message-id" article))))
|
||||
(mh-search "+" article))
|
||||
(if (org-mhe-get-message-real-folder)
|
||||
(mh-show-msg 1)
|
||||
(kill-this-buffer)
|
||||
(error "Message not found"))))
|
||||
|
||||
(provide 'org-mhe)
|
||||
|
||||
;;; org-mhe.el ends here
|
106
org-rmail.el
Normal file
106
org-rmail.el
Normal file
|
@ -0,0 +1,106 @@
|
|||
;;; org-rmail.el - Support for links to RMAIL messages in Org-mode
|
||||
|
||||
;; Copyright (C) 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Carsten Dominik <carsten at orgmode dot org>
|
||||
;; Keywords: outlines, hypermedia, calendar, wp
|
||||
;; Homepage: http://orgmode.org
|
||||
;; Version: 1.0
|
||||
;;
|
||||
;; 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, 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; see the file COPYING. If not, write to the
|
||||
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
||||
;; Boston, MA 02110-1301, USA.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;;; Commentary:
|
||||
|
||||
;; This file implements links to RMAIL messages for Org-mode.
|
||||
;; Org-mode loads this module by default - if this is not what you want,
|
||||
;; configure the variable `org-modules'.
|
||||
|
||||
(require 'org)
|
||||
|
||||
;; Declare external functions and variables
|
||||
(declare-function rmail-narrow-to-non-pruned-header "rmail" ())
|
||||
(declare-function rmail-show-message "rmail" (&optional n no-summary))
|
||||
(declare-function rmail-what-message "rmail" ())
|
||||
(defvar rmail-current-message)
|
||||
|
||||
;; Install the link type
|
||||
(org-add-link-type "rmail" 'org-rmail-open)
|
||||
(add-hook 'org-store-link-functions 'org-rmail-store-link)
|
||||
|
||||
;; Implementation
|
||||
(defun org-rmail-store-link ()
|
||||
"Store a link to an RMAIL folder or message."
|
||||
(when (or (eq major-mode 'rmail-mode)
|
||||
(eq major-mode 'rmail-summary-mode))
|
||||
(save-window-excursion
|
||||
(save-restriction
|
||||
(when (eq major-mode 'rmail-summary-mode)
|
||||
(rmail-show-message rmail-current-message))
|
||||
(rmail-narrow-to-non-pruned-header)
|
||||
(let* ((folder buffer-file-name)
|
||||
(message-id (mail-fetch-field "message-id"))
|
||||
(from (mail-fetch-field "from"))
|
||||
(to (mail-fetch-field "to"))
|
||||
(subject (mail-fetch-field "subject"))
|
||||
desc link)
|
||||
(org-store-link-props
|
||||
:type "rmail" :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 "rmail:" folder "#" message-id))
|
||||
(org-add-link-props :link link :description desc))
|
||||
(rmail-show-message rmail-current-message)))))
|
||||
|
||||
(defun org-rmail-open (path)
|
||||
"Follow an RMAIL message link."
|
||||
(let (folder article)
|
||||
(if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
|
||||
(error "Error in RMAIL link"))
|
||||
(setq folder (match-string 1 path)
|
||||
article (match-string 3 path))
|
||||
(org-rmail-follow-link folder article)))
|
||||
|
||||
(defun org-rmail-follow-link (folder article)
|
||||
"Follow an RMAIL link to FOLDER and ARTICLE."
|
||||
(require 'rmail)
|
||||
(setq article (org-add-angle-brackets article))
|
||||
(let (message-number)
|
||||
(save-excursion
|
||||
(save-window-excursion
|
||||
(rmail (if (string= folder "RMAIL") rmail-file-name folder))
|
||||
(setq message-number
|
||||
(save-restriction
|
||||
(widen)
|
||||
(goto-char (point-max))
|
||||
(if (re-search-backward
|
||||
(concat "^Message-ID:\\s-+" (regexp-quote
|
||||
(or article "")))
|
||||
nil t)
|
||||
(rmail-what-message))))))
|
||||
(if message-number
|
||||
(progn
|
||||
(rmail (if (string= folder "RMAIL") rmail-file-name folder))
|
||||
(rmail-show-message message-number)
|
||||
message-number)
|
||||
(error "Message not found"))))
|
||||
|
||||
(provide 'org-rmail)
|
||||
|
||||
;;; org-rmail.el ends here
|
128
org-vm.el
Normal file
128
org-vm.el
Normal file
|
@ -0,0 +1,128 @@
|
|||
;;; org-vm.el - Support for links to VM messages in Org-mode
|
||||
|
||||
;; Copyright (C) 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Carsten Dominik <carsten at orgmode dot org>
|
||||
;; Keywords: outlines, hypermedia, calendar, wp
|
||||
;; Homepage: http://orgmode.org
|
||||
;; Version: 1.0
|
||||
;;
|
||||
;; 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, 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; see the file COPYING. If not, write to the
|
||||
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
||||
;; Boston, MA 02110-1301, USA.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;;; Commentary:
|
||||
|
||||
;; This file implements links to VM messages and folders for Org-mode.
|
||||
;; Org-mode loads this module by default - if this is not what you want,
|
||||
;; configure the variable `org-modules'.
|
||||
|
||||
(require 'org)
|
||||
|
||||
;; Declare external functions and variables
|
||||
(declare-function vm-beginning-of-message "ext:vm-page" ())
|
||||
(declare-function vm-follow-summary-cursor "ext:vm-motion" ())
|
||||
(declare-function vm-get-header-contents "ext:vm-summary"
|
||||
(message header-name-regexp &optional clump-sep))
|
||||
(declare-function vm-isearch-narrow "ext:vm-search" ())
|
||||
(declare-function vm-isearch-update "ext:vm-search" ())
|
||||
(declare-function vm-select-folder-buffer "ext:vm-macro" ())
|
||||
(declare-function vm-su-message-id "ext:vm-summary" (m))
|
||||
(declare-function vm-su-subject "ext:vm-summary" (m))
|
||||
(declare-function vm-summarize "ext:vm-summary" (&optional display raise))
|
||||
(defvar vm-message-pointer)
|
||||
(defvar vm-folder-directory)
|
||||
|
||||
;; Install the link type
|
||||
(org-add-link-type "vm" 'org-vm-open)
|
||||
(add-hook 'org-store-link-functions 'org-vm-store-link)
|
||||
|
||||
;; Implementation
|
||||
(defun org-vm-store-link ()
|
||||
"Store a link to an VM folder or message."
|
||||
(when (or (eq major-mode 'vm-summary-mode)
|
||||
(eq major-mode 'vm-presentation-mode))
|
||||
(and (eq major-mode 'vm-presentation-mode) (vm-summarize))
|
||||
(vm-follow-summary-cursor)
|
||||
(save-excursion
|
||||
(vm-select-folder-buffer)
|
||||
(let* ((message (car vm-message-pointer))
|
||||
(folder buffer-file-name)
|
||||
(subject (vm-su-subject message))
|
||||
(to (vm-get-header-contents message "To"))
|
||||
(from (vm-get-header-contents message "From"))
|
||||
(message-id (vm-su-message-id message))
|
||||
desc link)
|
||||
(org-store-link-props :type "vm" :from from :to to :subject subject
|
||||
:message-id message-id)
|
||||
(setq message-id (org-remove-angle-brackets message-id))
|
||||
(setq folder (abbreviate-file-name folder))
|
||||
(if (string-match (concat "^" (regexp-quote vm-folder-directory))
|
||||
folder)
|
||||
(setq folder (replace-match "" t t folder)))
|
||||
(setq desc (org-email-link-description))
|
||||
(setq link (org-make-link "vm:" folder "#" message-id))
|
||||
(org-add-link-props :link link :description desc)))))
|
||||
|
||||
(defun org-vm-open (path)
|
||||
"Follow an VM message link."
|
||||
(let (folder article)
|
||||
(if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
|
||||
(error "Error in VM link"))
|
||||
(setq folder (match-string 1 path)
|
||||
article (match-string 3 path))
|
||||
;; The prefix arguemtn will be interpreted as read-only
|
||||
(org-vm-follow-link folder article current-prefix-arg)))
|
||||
|
||||
(defun org-vm-follow-link (&optional folder article readonly)
|
||||
"Follow a VM link to FOLDER and ARTICLE."
|
||||
(require 'vm)
|
||||
(setq article (org-add-angle-brackets article))
|
||||
(if (string-match "^//\\([a-zA-Z]+@\\)?\\([^:]+\\):\\(.*\\)" folder)
|
||||
;; ange-ftp or efs or tramp access
|
||||
(let ((user (or (match-string 1 folder) (user-login-name)))
|
||||
(host (match-string 2 folder))
|
||||
(file (match-string 3 folder)))
|
||||
(cond
|
||||
((featurep 'tramp)
|
||||
;; use tramp to access the file
|
||||
(if (featurep 'xemacs)
|
||||
(setq folder (format "[%s@%s]%s" user host file))
|
||||
(setq folder (format "/%s@%s:%s" user host file))))
|
||||
(t
|
||||
;; use ange-ftp or efs
|
||||
(require (if (featurep 'xemacs) 'efs 'ange-ftp))
|
||||
(setq folder (format "/%s@%s:%s" user host file))))))
|
||||
(when folder
|
||||
(funcall (cdr (assq 'vm org-link-frame-setup)) folder readonly)
|
||||
(sit-for 0.1)
|
||||
(when article
|
||||
(vm-select-folder-buffer)
|
||||
(widen)
|
||||
(let ((case-fold-search t))
|
||||
(goto-char (point-min))
|
||||
(if (not (re-search-forward
|
||||
(concat "^" "message-id: *" (regexp-quote article))))
|
||||
(error "Could not find the specified message in this folder"))
|
||||
(vm-isearch-update)
|
||||
(vm-isearch-narrow)
|
||||
(vm-beginning-of-message)
|
||||
(vm-summarize)))))
|
||||
|
||||
(provide 'org-vm)
|
||||
|
||||
;;; org-vm.el ends here
|
116
org-wl.el
Normal file
116
org-wl.el
Normal file
|
@ -0,0 +1,116 @@
|
|||
;;; org-wl.el - Support for links to Wanderlust messages in Org-mode
|
||||
|
||||
;; Copyright (C) 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Carsten Dominik <carsten at orgmode dot org>
|
||||
;; Keywords: outlines, hypermedia, calendar, wp
|
||||
;; Homepage: http://orgmode.org
|
||||
;; Version: 1.0
|
||||
;;
|
||||
;; 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, 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; see the file COPYING. If not, write to the
|
||||
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
||||
;; Boston, MA 02110-1301, USA.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;;; Commentary:
|
||||
|
||||
;; This file implements links to Wanderlust messages for Org-mode.
|
||||
;; Org-mode loads this module by default - if this is not what you want,
|
||||
;; configure the variable `org-modules'.
|
||||
|
||||
(require 'org)
|
||||
|
||||
;; Declare external functions and variables
|
||||
(declare-function elmo-folder-exists-p "ext:elmo" (folder) t)
|
||||
(declare-function elmo-message-entity-field "ext:elmo-msgdb"
|
||||
(entity field &optional type))
|
||||
(declare-function elmo-message-field "ext:elmo"
|
||||
(folder number field &optional type) t)
|
||||
(declare-function elmo-msgdb-overview-get-entity "ext:elmo" (&rest unknown) t)
|
||||
;; Backward compatibility to old version of wl
|
||||
(declare-function wl-summary-buffer-msgdb "ext:wl-folder" (&rest unknown) t)
|
||||
(declare-function wl-folder-get-elmo-folder "ext:wl-folder"
|
||||
(entity &optional no-cache))
|
||||
(declare-function wl-summary-goto-folder-subr "ext:wl-summary"
|
||||
(&optional name scan-type other-window sticky interactive
|
||||
scoring force-exit))
|
||||
(declare-function wl-summary-jump-to-msg-by-message-id "ext:wl-summary"
|
||||
(&optional id))
|
||||
(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" ())
|
||||
(declare-function wl-summary-redisplay "ext:wl-summary" (&optional arg))
|
||||
(defvar wl-summary-buffer-elmo-folder)
|
||||
(defvar wl-summary-buffer-folder-name)
|
||||
|
||||
;; Install the link type
|
||||
(org-add-link-type "wl" 'org-wl-open)
|
||||
(add-hook 'org-store-link-functions 'org-wl-store-link)
|
||||
|
||||
;; Implementation
|
||||
(defun org-wl-store-link ()
|
||||
"Store a link to an WL folder or message."
|
||||
(when (eq major-mode 'wl-summary-mode)
|
||||
(let* ((msgnum (wl-summary-message-number))
|
||||
(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 (wl-summary-line-from))
|
||||
(to (car (elmo-message-entity-field wl-message-entity 'to)))
|
||||
(subject (let (wl-thr-indent-string wl-parent-message-entity)
|
||||
(wl-summary-line-subject)))
|
||||
desc link)
|
||||
(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:" wl-summary-buffer-folder-name
|
||||
"#" message-id))
|
||||
(org-add-link-props :link link :description desc))))
|
||||
|
||||
(defun org-wl-open (path)
|
||||
"Follow an WL message link."
|
||||
(let (folder article)
|
||||
(if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
|
||||
(error "Error in Wanderlust link"))
|
||||
(setq folder (match-string 1 path)
|
||||
article (match-string 3 path))
|
||||
(org-wl-follow-link folder article)))
|
||||
|
||||
(defun org-wl-follow-link (folder article)
|
||||
"Follow a Wanderlust link to FOLDER and ARTICLE."
|
||||
(if (and (string= folder "%")
|
||||
article
|
||||
(string-match "^\\([^#]+\\)\\(#\\(.*\\)\\)?" article))
|
||||
;; XXX: imap-uw supports folders starting with '#' such as "#mh/inbox".
|
||||
;; Thus, we recompose folder and article ids.
|
||||
(setq folder (format "%s#%s" folder (match-string 1 article))
|
||||
article (match-string 3 article)))
|
||||
(if (not (elmo-folder-exists-p (wl-folder-get-elmo-folder folder)))
|
||||
(error "No such folder: %s" folder))
|
||||
(wl-summary-goto-folder-subr folder 'no-sync t nil t nil nil)
|
||||
(and article
|
||||
(wl-summary-jump-to-msg-by-message-id (org-add-angle-brackets article))
|
||||
(wl-summary-redisplay)))
|
||||
|
||||
(provide 'org-wl)
|
||||
|
||||
;;; org-wl.el ends here
|
565
org.el
565
org.el
|
@ -175,8 +175,8 @@ With prefix arg HERE, insert it at point."
|
|||
(when (featurep 'org)
|
||||
(org-load-modules-maybe 'force)))
|
||||
|
||||
(defcustom org-modules '(org-irc)
|
||||
"Extensions that should always be loaded together with org.el.
|
||||
(defcustom org-modules '(org-bbdb org-gnus org-info org-irc org-mhe org-rmail org-vm org-wl)
|
||||
"Modules that should always be loaded together with org.el.
|
||||
If the description starts with <A>, this means the extension
|
||||
will be autoloaded when needed, preloading is not necessary.
|
||||
If a description starts with <C>, the file is not part of emacs
|
||||
|
@ -186,11 +186,19 @@ the org-mode distribution."
|
|||
:set 'org-set-modules
|
||||
:type
|
||||
'(set :greedy t
|
||||
(const :tag "A export-latex: LaTeX export" org-export-latex)
|
||||
(const :tag " irc: IRC/ERC links" org-irc)
|
||||
(const :tag " mac-message: Apple Mail message links under OS X" org-mac-message)
|
||||
(const :tag " mouse: Mouse support" org-mouse)
|
||||
(const :tag "A publish: Publishing" org-publish)
|
||||
(const :tag " bbdb: Links to BBDB entries" org-bbdb)
|
||||
(const :tag " gnus: Links to GNUS folders/messages" org-gnus)
|
||||
(const :tag " info: Links to Info nodes" org-info)
|
||||
(const :tag " irc: Links to IRC/ERC chat sessions" org-irc)
|
||||
(const :tag " mac-message: Links to messages in Apple Mail" org-mac-message)
|
||||
(const :tag " mhe: Links to MHE folders/messages" org-mhe)
|
||||
(const :tag " rmail: Links to RMAIL folders/messages" org-rmail)
|
||||
(const :tag " vm: Links to VM folders/messages" org-vm)
|
||||
(const :tag " wl: Links to Wanderlust folders/messages" org-wl)
|
||||
(const :tag " mouse: Additional mouse support" org-mouse)
|
||||
; (const :tag "A export-latex: LaTeX export" org-export-latex)
|
||||
; (const :tag "A publish: Publishing" org-publish)
|
||||
|
||||
(const :tag "C annotate-file: Annotate a file with org syntax" org-annotate-file)
|
||||
(const :tag "C bibtex: Org links to BibTeX entries" org-bibtex)
|
||||
(const :tag "C depend: TODO dependencies for Org-mode" org-depend)
|
||||
|
@ -1261,14 +1269,6 @@ more efficient."
|
|||
:group 'org-link-store
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom org-usenet-links-prefer-google nil
|
||||
"Non-nil means, `org-store-link' will create web links to Google groups.
|
||||
When nil, Gnus will be used for such links.
|
||||
Using a prefix arg to the command \\[org-store-link] (`org-store-link')
|
||||
negates this setting for the duration of the command."
|
||||
:group 'org-link-store
|
||||
:type 'boolean)
|
||||
|
||||
(defgroup org-link-follow nil
|
||||
"Options concerning following links in Org-mode"
|
||||
:tag "Org Follow Link"
|
||||
|
@ -1485,14 +1485,6 @@ For more examples, see the system specific constants
|
|||
(string :tag "Command")
|
||||
(sexp :tag "Lisp form")))))
|
||||
|
||||
(defcustom org-mhe-search-all-folders nil
|
||||
"Non-nil means, that the search for the mh-message will be extended to
|
||||
all folders if the message cannot be found in the folder given in the link.
|
||||
Searching all folders is very efficient with one of the search engines
|
||||
supported by MH-E, but will be slow with pick."
|
||||
:group 'org-link-follow
|
||||
:type 'boolean)
|
||||
|
||||
(defgroup org-remember nil
|
||||
"Options concerning interaction with remember.el."
|
||||
:tag "Org Remember"
|
||||
|
@ -4389,13 +4381,6 @@ If it is less than 8, the level-1 face gets re-used for level N+1 etc."
|
|||
(declare-function add-to-diary-list "diary-lib"
|
||||
(date string specifier &optional marker globcolor literal))
|
||||
(declare-function table--at-cell-p "table" (position &optional object at-column))
|
||||
(declare-function Info-find-node "info" (filename nodename &optional no-going-back))
|
||||
(declare-function bbdb "ext:bbdb-com" (string elidep))
|
||||
(declare-function bbdb-company "ext:bbdb-com" (string elidep))
|
||||
(declare-function bbdb-current-record "ext:bbdb-com" (&optional planning-on-modifying))
|
||||
(declare-function bbdb-name "ext:bbdb-com" (string elidep))
|
||||
(declare-function bbdb-record-getprop "ext:bbdb" (record property))
|
||||
(declare-function bbdb-record-name "ext:bbdb" (record))
|
||||
(declare-function bibtex-beginning-of-entry "bibtex" ())
|
||||
(declare-function bibtex-generate-autokey "bibtex" ())
|
||||
(declare-function bibtex-parse-entry "bibtex" (&optional content))
|
||||
|
@ -4422,39 +4407,9 @@ If it is less than 8, the level-1 face gets re-used for level N+1 etc."
|
|||
(defvar original-date) ; dynamically scoped in calendar.el does scope this
|
||||
(declare-function cdlatex-tab "ext:cdlatex" ())
|
||||
(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep))
|
||||
(declare-function elmo-folder-exists-p "ext:elmo" (folder) t)
|
||||
(declare-function elmo-message-entity-field "ext:elmo-msgdb" (entity field &optional type))
|
||||
(declare-function elmo-message-field "ext:elmo" (folder number field &optional type) t)
|
||||
(declare-function elmo-msgdb-overview-get-entity "ext:elmo" (&rest unknown) t)
|
||||
(defvar font-lock-unfontify-region-function)
|
||||
(declare-function gnus-article-show-summary "gnus-art" ())
|
||||
(declare-function gnus-summary-last-subject "gnus-sum" ())
|
||||
(defvar gnus-other-frame-object)
|
||||
(defvar gnus-group-name)
|
||||
(defvar gnus-article-current)
|
||||
(defvar Info-current-file)
|
||||
(defvar Info-current-node)
|
||||
(declare-function mh-display-msg "mh-show" (msg-num folder-name))
|
||||
(declare-function mh-find-path "mh-utils" ())
|
||||
(declare-function mh-get-header-field "mh-utils" (field))
|
||||
(declare-function mh-get-msg-num "mh-utils" (error-if-no-message))
|
||||
(declare-function mh-header-display "mh-show" ())
|
||||
(declare-function mh-index-previous-folder "mh-search" ())
|
||||
(declare-function mh-normalize-folder-name "mh-utils" (folder &optional empty-string-okay dont-remove-trailing-slash return-nil-if-folder-empty))
|
||||
(declare-function mh-search "mh-search" (folder search-regexp &optional redo-search-flag window-config))
|
||||
(declare-function mh-search-choose "mh-search" (&optional searcher))
|
||||
(declare-function mh-show "mh-show" (&optional message redisplay-flag))
|
||||
(declare-function mh-show-buffer-message-number "mh-comp" (&optional buffer))
|
||||
(declare-function mh-show-header-display "mh-show" t t)
|
||||
(declare-function mh-show-msg "mh-show" (msg))
|
||||
(declare-function mh-show-show "mh-show" t t)
|
||||
(declare-function mh-visit-folder "mh-folder" (folder &optional range index-data))
|
||||
(defvar mh-progs)
|
||||
(defvar mh-current-folder)
|
||||
(defvar mh-show-folder-buffer)
|
||||
(defvar mh-index-folder)
|
||||
(defvar mh-searcher)
|
||||
(declare-function org-export-latex-cleaned-string "org-export-latex" ())
|
||||
(declare-function org-gnus-follow-link "org-gnus" (&optional group article))
|
||||
(declare-function parse-time-string "parse-time" (string))
|
||||
(declare-function remember "remember" (&optional initial))
|
||||
(declare-function remember-buffer-desc "remember" ())
|
||||
|
@ -4465,36 +4420,11 @@ If it is less than 8, the level-1 face gets re-used for level N+1 etc."
|
|||
(defvar remember-buffer)
|
||||
(defvar remember-handler-functions)
|
||||
(defvar remember-annotation-functions)
|
||||
(declare-function rmail-narrow-to-non-pruned-header "rmail" ())
|
||||
(declare-function rmail-show-message "rmail" (&optional n no-summary))
|
||||
(declare-function rmail-what-message "rmail" ())
|
||||
(defvar rmail-current-message)
|
||||
(defvar texmathp-why)
|
||||
(declare-function vm-beginning-of-message "ext:vm-page" ())
|
||||
(declare-function vm-follow-summary-cursor "ext:vm-motion" ())
|
||||
(declare-function vm-get-header-contents "ext:vm-summary" (message header-name-regexp &optional clump-sep))
|
||||
(declare-function vm-isearch-narrow "ext:vm-search" ())
|
||||
(declare-function vm-isearch-update "ext:vm-search" ())
|
||||
(declare-function vm-select-folder-buffer "ext:vm-macro" ())
|
||||
(declare-function vm-su-message-id "ext:vm-summary" (m))
|
||||
(declare-function vm-su-subject "ext:vm-summary" (m))
|
||||
(declare-function vm-summarize "ext:vm-summary" (&optional display raise))
|
||||
(defvar vm-message-pointer)
|
||||
(defvar vm-folder-directory)
|
||||
(declare-function speedbar-line-directory "speedbar" (&optional depth))
|
||||
|
||||
(defvar w3m-current-url)
|
||||
(defvar w3m-current-title)
|
||||
;; backward compatibility to old version of wl
|
||||
(declare-function wl-summary-buffer-msgdb "ext:wl-folder" (&rest unknown) t)
|
||||
(declare-function wl-folder-get-elmo-folder "ext:wl-folder" (entity &optional no-cache))
|
||||
(declare-function wl-summary-goto-folder-subr "ext:wl-summary" (&optional name scan-type other-window sticky interactive scoring force-exit))
|
||||
(declare-function wl-summary-jump-to-msg-by-message-id "ext:wl-summary" (&optional id))
|
||||
(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" ())
|
||||
(declare-function wl-summary-redisplay "ext:wl-summary" (&optional arg))
|
||||
(defvar wl-summary-buffer-elmo-folder)
|
||||
(defvar wl-summary-buffer-folder-name)
|
||||
(declare-function speedbar-line-directory "speedbar" (&optional depth))
|
||||
|
||||
(defvar org-latex-regexps)
|
||||
(defvar constants-unit-system)
|
||||
|
@ -5251,8 +5181,8 @@ that will be added to PLIST. Returns the string that was modified."
|
|||
(require 'font-lock)
|
||||
|
||||
(defconst org-non-link-chars "]\t\n\r<>")
|
||||
(defvar org-link-types '("http" "https" "ftp" "mailto" "file" "news" "bbdb" "vm"
|
||||
"wl" "mhe" "rmail" "gnus" "shell" "info" "elisp" "message"))
|
||||
(defvar org-link-types '("http" "https" "ftp" "mailto" "file" "news"
|
||||
"shell" "elisp"))
|
||||
(defvar org-link-re-with-space nil
|
||||
"Matches a link with spaces, optional angular brackets around it.")
|
||||
(defvar org-link-re-with-space2 nil
|
||||
|
@ -12177,20 +12107,35 @@ Special properties are:
|
|||
In addition to these, any additional properties can be specified
|
||||
and then used in remember templates.")
|
||||
|
||||
(defun org-add-link-type (type &optional follow publish)
|
||||
(defun org-add-link-type (type &optional follow export)
|
||||
"Add TYPE to the list of `org-link-types'.
|
||||
Re-compute all regular expressions depending on `org-link-types'
|
||||
FOLLOW and PUBLISH are two functions. Both take the link path as
|
||||
an argument.
|
||||
FOLLOW should do whatever is necessary to follow the link, for example
|
||||
to find a file or display a mail message.
|
||||
|
||||
PUBLISH takes the path and retuns the string that should be used when
|
||||
this document is published. FIMXE: This is actually not yet implemented."
|
||||
FOLLOW and EXPORT are two functions.
|
||||
|
||||
FOLLOW should take the link path as the single argument and do whatever
|
||||
is necessary to follow the link, for example find a file or display
|
||||
a mail message.
|
||||
|
||||
EXPORT should format the link path for export to one of the export formats.
|
||||
It should be a function accepting three arguments:
|
||||
|
||||
path the path of the link, the text after the prefix (like \"http:\")
|
||||
desc the description of the link, if any, nil if there was no descripton
|
||||
format the export format, a symbol like `html' or `latex'.
|
||||
|
||||
The function may use the FORMAT information to return different values
|
||||
depending on the format. The return value will be put literally into
|
||||
the exported file.
|
||||
Org-mode has a built-in default for exporting links. If you are happy with
|
||||
this default, there is no need to define an export function for the link
|
||||
type. For a simple example of an export function, see `org-bbdb.el'."
|
||||
(add-to-list 'org-link-types type t)
|
||||
(org-make-link-regexps)
|
||||
(add-to-list 'org-link-protocols
|
||||
(list type follow publish)))
|
||||
(if (assoc type org-link-protocols)
|
||||
(setcdr (assoc type org-link-protocols) (list follow export))
|
||||
(push (list type follow export) org-link-protocols)))
|
||||
|
||||
|
||||
(defun org-add-agenda-custom-command (entry)
|
||||
"Replace or add a command in `org-agenda-custom-commands'.
|
||||
|
@ -12220,22 +12165,6 @@ For file links, arg negates `org-context-in-file-links'."
|
|||
(setq link (plist-get org-store-link-plist :link)
|
||||
desc (or (plist-get org-store-link-plist :description) link)))
|
||||
|
||||
((eq major-mode 'bbdb-mode)
|
||||
(let ((name (bbdb-record-name (bbdb-current-record)))
|
||||
(company (bbdb-record-getprop (bbdb-current-record) 'company)))
|
||||
(setq cpltxt (concat "bbdb:" (or name company))
|
||||
link (org-make-link cpltxt))
|
||||
(org-store-link-props :type "bbdb" :name name :company company)))
|
||||
|
||||
((eq major-mode 'Info-mode)
|
||||
(setq link (org-make-link "info:"
|
||||
(file-name-nondirectory Info-current-file)
|
||||
":" Info-current-node))
|
||||
(setq cpltxt (concat (file-name-nondirectory Info-current-file)
|
||||
":" Info-current-node))
|
||||
(org-store-link-props :type "info" :file Info-current-file
|
||||
:node Info-current-node))
|
||||
|
||||
((eq major-mode 'calendar-mode)
|
||||
(let ((cd (calendar-cursor-to-date)))
|
||||
(setq link
|
||||
|
@ -12246,117 +12175,6 @@ For file links, arg negates `org-context-in-file-links'."
|
|||
nil nil nil))))
|
||||
(org-store-link-props :type "calendar" :date cd)))
|
||||
|
||||
((or (eq major-mode 'vm-summary-mode)
|
||||
(eq major-mode 'vm-presentation-mode))
|
||||
(and (eq major-mode 'vm-presentation-mode) (vm-summarize))
|
||||
(vm-follow-summary-cursor)
|
||||
(save-excursion
|
||||
(vm-select-folder-buffer)
|
||||
(let* ((message (car vm-message-pointer))
|
||||
(folder buffer-file-name)
|
||||
(subject (vm-su-subject message))
|
||||
(to (vm-get-header-contents message "To"))
|
||||
(from (vm-get-header-contents message "From"))
|
||||
(message-id (vm-su-message-id message)))
|
||||
(org-store-link-props :type "vm" :from from :to to :subject subject
|
||||
:message-id message-id)
|
||||
(setq message-id (org-remove-angle-brackets message-id))
|
||||
(setq folder (abbreviate-file-name folder))
|
||||
(if (string-match (concat "^" (regexp-quote vm-folder-directory))
|
||||
folder)
|
||||
(setq folder (replace-match "" t t folder)))
|
||||
(setq cpltxt (org-email-link-description))
|
||||
(setq link (org-make-link "vm:" folder "#" message-id)))))
|
||||
|
||||
((eq major-mode 'wl-summary-mode)
|
||||
(let* ((msgnum (wl-summary-message-number))
|
||||
(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 (wl-summary-line-from))
|
||||
(to (car (elmo-message-entity-field wl-message-entity 'to)))
|
||||
(subject (let (wl-thr-indent-string wl-parent-message-entity)
|
||||
(wl-summary-line-subject))))
|
||||
(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 cpltxt (org-email-link-description))
|
||||
(setq link (org-make-link "wl:" wl-summary-buffer-folder-name
|
||||
"#" message-id))))
|
||||
|
||||
((or (equal major-mode 'mh-folder-mode)
|
||||
(equal major-mode 'mh-show-mode))
|
||||
(let ((from (org-mhe-get-header "From:"))
|
||||
(to (org-mhe-get-header "To:"))
|
||||
(message-id (org-mhe-get-header "Message-Id:"))
|
||||
(subject (org-mhe-get-header "Subject:")))
|
||||
(org-store-link-props :type "mh" :from from :to to
|
||||
:subject subject :message-id message-id)
|
||||
(setq cpltxt (org-email-link-description))
|
||||
(setq link (org-make-link "mhe:" (org-mhe-get-message-real-folder) "#"
|
||||
(org-remove-angle-brackets message-id)))))
|
||||
|
||||
((or (eq major-mode 'rmail-mode)
|
||||
(eq major-mode 'rmail-summary-mode))
|
||||
(save-window-excursion
|
||||
(save-restriction
|
||||
(when (eq major-mode 'rmail-summary-mode)
|
||||
(rmail-show-message rmail-current-message))
|
||||
(rmail-narrow-to-non-pruned-header)
|
||||
(let ((folder buffer-file-name)
|
||||
(message-id (mail-fetch-field "message-id"))
|
||||
(from (mail-fetch-field "from"))
|
||||
(to (mail-fetch-field "to"))
|
||||
(subject (mail-fetch-field "subject")))
|
||||
(org-store-link-props
|
||||
:type "rmail" :from from :to to
|
||||
:subject subject :message-id message-id)
|
||||
(setq message-id (org-remove-angle-brackets message-id))
|
||||
(setq cpltxt (org-email-link-description))
|
||||
(setq link (org-make-link "rmail:" folder "#" message-id)))
|
||||
(rmail-show-message rmail-current-message))))
|
||||
|
||||
((eq major-mode 'gnus-group-mode)
|
||||
(let ((group (cond ((fboundp 'gnus-group-group-name) ; depending on Gnus
|
||||
(gnus-group-group-name)) ; version
|
||||
((fboundp 'gnus-group-name)
|
||||
(gnus-group-name))
|
||||
(t "???"))))
|
||||
(unless group (error "Not on a group"))
|
||||
(org-store-link-props :type "gnus" :group group)
|
||||
(setq cpltxt (concat
|
||||
(if (org-xor arg org-usenet-links-prefer-google)
|
||||
"http://groups.google.com/groups?group="
|
||||
"gnus:")
|
||||
group)
|
||||
link (org-make-link cpltxt))))
|
||||
|
||||
((memq major-mode '(gnus-summary-mode gnus-article-mode))
|
||||
(and (eq major-mode 'gnus-article-mode) (gnus-article-show-summary))
|
||||
(let* ((group gnus-newsgroup-name)
|
||||
(article (gnus-summary-article-number))
|
||||
(header (gnus-summary-article-header article))
|
||||
(from (mail-header-from header))
|
||||
(message-id (mail-header-id header))
|
||||
(date (mail-header-date header))
|
||||
(subject (gnus-summary-subject-string)))
|
||||
(org-store-link-props :type "gnus" :from from :subject subject
|
||||
:message-id message-id :group group)
|
||||
(setq cpltxt (org-email-link-description))
|
||||
(if (org-xor arg org-usenet-links-prefer-google)
|
||||
(setq link
|
||||
(concat
|
||||
cpltxt "\n "
|
||||
(format "http://groups.google.com/groups?as_umsgid=%s"
|
||||
(org-fixup-message-id-for-http message-id))))
|
||||
(setq link (org-make-link "gnus:" group
|
||||
"#" (number-to-string article))))))
|
||||
|
||||
((eq major-mode 'w3-mode)
|
||||
(setq cpltxt (url-view-url t)
|
||||
link (org-make-link cpltxt))
|
||||
|
@ -12463,6 +12281,13 @@ For file links, arg negates `org-context-in-file-links'."
|
|||
(concat "from %f")))))
|
||||
(setq org-store-link-plist plist))
|
||||
|
||||
(defun org-add-link-props (&rest plist)
|
||||
"Add these properties to the link property list."
|
||||
(let (key value)
|
||||
(while plist
|
||||
(setq key (pop plist) value (pop plist))
|
||||
(plist-put org-store-link-plist key value))))
|
||||
|
||||
(defun org-email-link-description (&optional fmt)
|
||||
"Return the description part of an email link.
|
||||
This takes information from `org-store-link-plist' and formats it
|
||||
|
@ -12979,54 +12804,8 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file."
|
|||
(org-open-file path in-emacs line search)))
|
||||
|
||||
((string= type "news")
|
||||
(org-follow-gnus-link path))
|
||||
|
||||
((string= type "bbdb")
|
||||
(org-follow-bbdb-link path))
|
||||
|
||||
((string= type "info")
|
||||
(org-follow-info-link path))
|
||||
|
||||
((string= type "gnus")
|
||||
(let (group article)
|
||||
(if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
|
||||
(error "Error in Gnus link"))
|
||||
(setq group (match-string 1 path)
|
||||
article (match-string 3 path))
|
||||
(org-follow-gnus-link group article)))
|
||||
|
||||
((string= type "vm")
|
||||
(let (folder article)
|
||||
(if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
|
||||
(error "Error in VM link"))
|
||||
(setq folder (match-string 1 path)
|
||||
article (match-string 3 path))
|
||||
;; in-emacs is the prefix arg, will be interpreted as read-only
|
||||
(org-follow-vm-link folder article in-emacs)))
|
||||
|
||||
((string= type "wl")
|
||||
(let (folder article)
|
||||
(if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
|
||||
(error "Error in Wanderlust link"))
|
||||
(setq folder (match-string 1 path)
|
||||
article (match-string 3 path))
|
||||
(org-follow-wl-link folder article)))
|
||||
|
||||
((string= type "mhe")
|
||||
(let (folder article)
|
||||
(if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
|
||||
(error "Error in MHE link"))
|
||||
(setq folder (match-string 1 path)
|
||||
article (match-string 3 path))
|
||||
(org-follow-mhe-link folder article)))
|
||||
|
||||
((string= type "rmail")
|
||||
(let (folder article)
|
||||
(if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
|
||||
(error "Error in RMAIL link"))
|
||||
(setq folder (match-string 1 path)
|
||||
article (match-string 3 path))
|
||||
(org-follow-rmail-link folder article)))
|
||||
(require 'org-gnus)
|
||||
(org-gnus-follow-link path))
|
||||
|
||||
((string= type "shell")
|
||||
(let ((cmd path))
|
||||
|
@ -13311,231 +13090,6 @@ onto the ring."
|
|||
(t (error "This should not happen"))))
|
||||
|
||||
|
||||
(defun org-follow-bbdb-link (name)
|
||||
"Follow a BBDB link to NAME."
|
||||
(require 'bbdb)
|
||||
(let ((inhibit-redisplay (not debug-on-error))
|
||||
(bbdb-electric-p nil))
|
||||
(catch 'exit
|
||||
;; Exact match on name
|
||||
(bbdb-name (concat "\\`" name "\\'") nil)
|
||||
(if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
|
||||
;; Exact match on name
|
||||
(bbdb-company (concat "\\`" name "\\'") nil)
|
||||
(if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
|
||||
;; Partial match on name
|
||||
(bbdb-name name nil)
|
||||
(if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
|
||||
;; Partial match on company
|
||||
(bbdb-company name nil)
|
||||
(if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
|
||||
;; General match including network address and notes
|
||||
(bbdb name nil)
|
||||
(when (= 0 (buffer-size (get-buffer "*BBDB*")))
|
||||
(delete-window (get-buffer-window "*BBDB*"))
|
||||
(error "No matching BBDB record")))))
|
||||
|
||||
(defun org-follow-info-link (name)
|
||||
"Follow an info file & node link to NAME."
|
||||
(if (or (string-match "\\(.*\\)::?\\(.*\\)" name)
|
||||
(string-match "\\(.*\\)" name))
|
||||
(progn
|
||||
(require 'info)
|
||||
(if (match-string 2 name) ; If there isn't a node, choose "Top"
|
||||
(Info-find-node (match-string 1 name) (match-string 2 name))
|
||||
(Info-find-node (match-string 1 name) "Top")))
|
||||
(message "Could not open: %s" name)))
|
||||
|
||||
(defun org-follow-gnus-link (&optional group article)
|
||||
"Follow a Gnus link to GROUP and ARTICLE."
|
||||
(require 'gnus)
|
||||
(funcall (cdr (assq 'gnus org-link-frame-setup)))
|
||||
(if gnus-other-frame-object (select-frame gnus-other-frame-object))
|
||||
(cond ((and group article)
|
||||
(gnus-group-read-group 1 nil group)
|
||||
(gnus-summary-goto-article (string-to-number article) nil t))
|
||||
(group (gnus-group-jump-to-group group))))
|
||||
|
||||
(defun org-follow-vm-link (&optional folder article readonly)
|
||||
"Follow a VM link to FOLDER and ARTICLE."
|
||||
(require 'vm)
|
||||
(setq article (org-add-angle-brackets article))
|
||||
(if (string-match "^//\\([a-zA-Z]+@\\)?\\([^:]+\\):\\(.*\\)" folder)
|
||||
;; ange-ftp or efs or tramp access
|
||||
(let ((user (or (match-string 1 folder) (user-login-name)))
|
||||
(host (match-string 2 folder))
|
||||
(file (match-string 3 folder)))
|
||||
(cond
|
||||
((featurep 'tramp)
|
||||
;; use tramp to access the file
|
||||
(if (featurep 'xemacs)
|
||||
(setq folder (format "[%s@%s]%s" user host file))
|
||||
(setq folder (format "/%s@%s:%s" user host file))))
|
||||
(t
|
||||
;; use ange-ftp or efs
|
||||
(require (if (featurep 'xemacs) 'efs 'ange-ftp))
|
||||
(setq folder (format "/%s@%s:%s" user host file))))))
|
||||
(when folder
|
||||
(funcall (cdr (assq 'vm org-link-frame-setup)) folder readonly)
|
||||
(sit-for 0.1)
|
||||
(when article
|
||||
(vm-select-folder-buffer)
|
||||
(widen)
|
||||
(let ((case-fold-search t))
|
||||
(goto-char (point-min))
|
||||
(if (not (re-search-forward
|
||||
(concat "^" "message-id: *" (regexp-quote article))))
|
||||
(error "Could not find the specified message in this folder"))
|
||||
(vm-isearch-update)
|
||||
(vm-isearch-narrow)
|
||||
(vm-beginning-of-message)
|
||||
(vm-summarize)))))
|
||||
|
||||
(defun org-follow-wl-link (folder article)
|
||||
"Follow a Wanderlust link to FOLDER and ARTICLE."
|
||||
(if (and (string= folder "%")
|
||||
article
|
||||
(string-match "^\\([^#]+\\)\\(#\\(.*\\)\\)?" article))
|
||||
;; XXX: imap-uw supports folders starting with '#' such as "#mh/inbox".
|
||||
;; Thus, we recompose folder and article ids.
|
||||
(setq folder (format "%s#%s" folder (match-string 1 article))
|
||||
article (match-string 3 article)))
|
||||
(if (not (elmo-folder-exists-p (wl-folder-get-elmo-folder folder)))
|
||||
(error "No such folder: %s" folder))
|
||||
(wl-summary-goto-folder-subr folder 'no-sync t nil t nil nil)
|
||||
(and article
|
||||
(wl-summary-jump-to-msg-by-message-id (org-add-angle-brackets article))
|
||||
(wl-summary-redisplay)))
|
||||
|
||||
(defun org-follow-rmail-link (folder article)
|
||||
"Follow an RMAIL link to FOLDER and ARTICLE."
|
||||
(setq article (org-add-angle-brackets article))
|
||||
(let (message-number)
|
||||
(save-excursion
|
||||
(save-window-excursion
|
||||
(rmail (if (string= folder "RMAIL") rmail-file-name folder))
|
||||
(setq message-number
|
||||
(save-restriction
|
||||
(widen)
|
||||
(goto-char (point-max))
|
||||
(if (re-search-backward
|
||||
(concat "^Message-ID:\\s-+" (regexp-quote
|
||||
(or article "")))
|
||||
nil t)
|
||||
(rmail-what-message))))))
|
||||
(if message-number
|
||||
(progn
|
||||
(rmail (if (string= folder "RMAIL") rmail-file-name folder))
|
||||
(rmail-show-message message-number)
|
||||
message-number)
|
||||
(error "Message not found"))))
|
||||
|
||||
;;; mh-e integration based on planner-mode
|
||||
(defun org-mhe-get-message-real-folder ()
|
||||
"Return the name of the current message real folder, so if you use
|
||||
sequences, it will now work."
|
||||
(save-excursion
|
||||
(let* ((folder
|
||||
(if (equal major-mode 'mh-folder-mode)
|
||||
mh-current-folder
|
||||
;; Refer to the show buffer
|
||||
mh-show-folder-buffer))
|
||||
(end-index
|
||||
(if (boundp 'mh-index-folder)
|
||||
(min (length mh-index-folder) (length folder))))
|
||||
)
|
||||
;; a simple test on mh-index-data does not work, because
|
||||
;; mh-index-data is always nil in a show buffer.
|
||||
(if (and (boundp 'mh-index-folder)
|
||||
(string= mh-index-folder (substring folder 0 end-index)))
|
||||
(if (equal major-mode 'mh-show-mode)
|
||||
(save-window-excursion
|
||||
(let (pop-up-frames)
|
||||
(when (buffer-live-p (get-buffer folder))
|
||||
(progn
|
||||
(pop-to-buffer folder)
|
||||
(org-mhe-get-message-folder-from-index)
|
||||
)
|
||||
)))
|
||||
(org-mhe-get-message-folder-from-index)
|
||||
)
|
||||
folder
|
||||
)
|
||||
)))
|
||||
|
||||
(defun org-mhe-get-message-folder-from-index ()
|
||||
"Returns the name of the message folder in a index folder buffer."
|
||||
(save-excursion
|
||||
(mh-index-previous-folder)
|
||||
(re-search-forward "^\\(+.*\\)$" nil t)
|
||||
(message "%s" (match-string 1))))
|
||||
|
||||
(defun org-mhe-get-message-folder ()
|
||||
"Return the name of the current message folder. Be careful if you
|
||||
use sequences."
|
||||
(save-excursion
|
||||
(if (equal major-mode 'mh-folder-mode)
|
||||
mh-current-folder
|
||||
;; Refer to the show buffer
|
||||
mh-show-folder-buffer)))
|
||||
|
||||
(defun org-mhe-get-message-num ()
|
||||
"Return the number of the current message. Be careful if you
|
||||
use sequences."
|
||||
(save-excursion
|
||||
(if (equal major-mode 'mh-folder-mode)
|
||||
(mh-get-msg-num nil)
|
||||
;; Refer to the show buffer
|
||||
(mh-show-buffer-message-number))))
|
||||
|
||||
(defun org-mhe-get-header (header)
|
||||
"Return a header of the message in folder mode. This will create a
|
||||
show buffer for the corresponding message. If you have a more clever
|
||||
idea..."
|
||||
(let* ((folder (org-mhe-get-message-folder))
|
||||
(num (org-mhe-get-message-num))
|
||||
(buffer (get-buffer-create (concat "show-" folder)))
|
||||
(header-field))
|
||||
(with-current-buffer buffer
|
||||
(mh-display-msg num folder)
|
||||
(if (equal major-mode 'mh-folder-mode)
|
||||
(mh-header-display)
|
||||
(mh-show-header-display))
|
||||
(set-buffer buffer)
|
||||
(setq header-field (mh-get-header-field header))
|
||||
(if (equal major-mode 'mh-folder-mode)
|
||||
(mh-show)
|
||||
(mh-show-show))
|
||||
header-field)))
|
||||
|
||||
(defun org-follow-mhe-link (folder article)
|
||||
"Follow an MHE link to FOLDER and ARTICLE.
|
||||
If ARTICLE is nil FOLDER is shown. If the configuration variable
|
||||
`org-mhe-search-all-folders' is t and `mh-searcher' is pick,
|
||||
ARTICLE is searched in all folders. Indexed searches (swish++,
|
||||
namazu, and others supported by MH-E) will always search in all
|
||||
folders."
|
||||
(require 'mh-e)
|
||||
(require 'mh-search)
|
||||
(require 'mh-utils)
|
||||
(mh-find-path)
|
||||
(if (not article)
|
||||
(mh-visit-folder (mh-normalize-folder-name folder))
|
||||
(setq article (org-add-angle-brackets article))
|
||||
(mh-search-choose)
|
||||
(if (equal mh-searcher 'pick)
|
||||
(progn
|
||||
(mh-search folder (list "--message-id" article))
|
||||
(when (and org-mhe-search-all-folders
|
||||
(not (org-mhe-get-message-real-folder)))
|
||||
(kill-this-buffer)
|
||||
(mh-search "+" (list "--message-id" article))))
|
||||
(mh-search "+" article))
|
||||
(if (org-mhe-get-message-real-folder)
|
||||
(mh-show-msg 1)
|
||||
(kill-this-buffer)
|
||||
(error "Message not found"))))
|
||||
|
||||
;;; BibTeX links
|
||||
|
||||
;; Use the custom search meachnism to construct and use search strings for
|
||||
|
@ -25746,7 +25300,7 @@ PUB-DIR is set, use this as the publishing directory."
|
|||
table-buffer table-orig-buffer
|
||||
ind start-is-num starter didclose
|
||||
rpl path desc descp desc1 desc2 link
|
||||
snumber
|
||||
snumber fnc
|
||||
)
|
||||
|
||||
(let ((inhibit-read-only t))
|
||||
|
@ -26053,13 +25607,20 @@ lang=\"%s\" xml:lang=\"%s\">
|
|||
(concat "<img src=\"" thefile "\"/>")
|
||||
(concat "<a href=\"" thefile "\">" desc "</a>")))
|
||||
(if (not valid) (setq rpl desc))))
|
||||
((member type '("bbdb" "vm" "wl" "mhe" "rmail" "gnus" "shell" "info" "elisp"))
|
||||
|
||||
((functionp (setq fnc (nth 2 (assoc type org-link-protocols))))
|
||||
(setq rpl
|
||||
(save-match-data
|
||||
(funcall fnc (org-link-unescape path) desc1 'html))))
|
||||
|
||||
(t
|
||||
;; just publish the path, as default
|
||||
(setq rpl (concat "<i><" type ":"
|
||||
(save-match-data (org-link-unescape path))
|
||||
"></i>"))))
|
||||
(setq line (replace-match rpl t t line)
|
||||
start (+ start (length rpl))))
|
||||
|
||||
|
||||
;; TODO items
|
||||
(if (and (string-match org-todo-line-regexp line)
|
||||
(match-beginning 2))
|
||||
|
|
Loading…
Reference in a new issue