org-mode/lisp/org-protocol.el

739 lines
28 KiB
EmacsLisp
Raw Normal View History

;;; org-protocol.el --- Intercept Calls from Emacsclient to Trigger Custom Actions -*- lexical-binding: t; -*-
2009-03-30 09:47:34 -04:00
;;
2020-01-01 13:38:46 -05:00
;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
2009-03-30 09:47:34 -04:00
;;
;; Authors: Bastien Guerry <bzg@gnu.org>
2012-04-01 18:53:28 -04:00
;; Daniel M German <dmg AT uvic DOT org>
;; Sebastian Rose <sebastian_rose AT gmx DOT de>
;; Ross Patterson <me AT rpatterson DOT net>
2009-03-30 09:47:34 -04:00
;; Maintainer: Sebastian Rose <sebastian_rose AT gmx DOT de>
;; Keywords: org, emacsclient, wp
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software: you can redistribute it and/or modify
2009-03-30 09:47:34 -04:00
;; 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,
2009-03-30 09:47:34 -04:00
;; 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 <https://www.gnu.org/licenses/>.
2009-03-30 09:47:34 -04:00
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Commentary:
;;
;; Intercept calls from emacsclient to trigger custom actions.
;;
;; This is done by advising `server-visit-files' to scan the list of filenames
;; for `org-protocol-the-protocol' and sub-protocols defined in
2009-03-30 09:47:34 -04:00
;; `org-protocol-protocol-alist' and `org-protocol-protocol-alist-default'.
;;
;; Any application that supports calling external programs with an URL
;; as argument may be used with this functionality.
;;
;;
;; Usage:
;; ------
;;
;; 1.) Add this to your init file (.emacs probably):
;;
;; (add-to-list 'load-path "/path/to/org-protocol/")
;; (require 'org-protocol)
;;
;; 3.) Ensure emacs-server is up and running.
;; 4.) Try this from the command line (adjust the URL as needed):
;;
;; $ emacsclient \
;; org-protocol://store-link?url=http:%2F%2Flocalhost%2Findex.html&title=The%20title
2009-03-30 09:47:34 -04:00
;;
;; 5.) Optionally add custom sub-protocols and handlers:
;;
;; (setq org-protocol-protocol-alist
;; '(("my-protocol"
;; :protocol "my-protocol"
;; :function my-protocol-handler-function)))
2009-03-30 09:47:34 -04:00
;;
;; A "sub-protocol" will be found in URLs like this:
;;
;; org-protocol://sub-protocol?key=val&key2=val2
2009-03-30 09:47:34 -04:00
;;
;; If it works, you can now setup other applications for using this feature.
;;
;;
;; As of March 2009 Firefox users follow the steps documented on
;; http://kb.mozillazine.org/Register_protocol, Opera setup is described here:
;; http://www.opera.com/support/kb/view/535/
;;
;;
;; Documentation
;; -------------
;;
;; org-protocol.el comes with and installs handlers to open sources of published
;; online content, store and insert the browser's URLs and cite online content
;; by clicking on a bookmark in Firefox, Opera and probably other browsers and
;; applications:
;;
;; * `org-protocol-open-source' uses the sub-protocol \"open-source\" and maps
;; URLs to local filenames defined in `org-protocol-project-alist'.
;;
;; * `org-protocol-store-link' stores an Org link (if Org is present) and
;; pushes the browsers URL to the `kill-ring' for yanking. This handler is
2009-03-30 09:47:34 -04:00
;; triggered through the sub-protocol \"store-link\".
;;
New implementation of the Org remember process ready for comments and testing Carsten Dominik <carsten.dominik@gmail.com> writes: > 3 Why a new name? > ~~~~~~~~~~~~~~~~~~ > > I have - at least for now - chosen a new name for the new setup: > ` org-capture'. There are two reasons for this: In the manual it is "Capture - Refile - Archive". I remember searching for "Remember" and never found it :) > 5 Setup > ~~~~~~~~ > > To use the new setup, do the following: > > 1. Run > > M-x org-capture-import-remember-templates RET Worked perfectly here :) I tested all my important templates and they work. Abandoning org-remember seems painless. > '(("t" "templates adding table lines") > ("ta" "add to table a" table-line (file+headline "~/notes.org" "Table A)) > ("tb" "add to table b" table-line (file+headline "~/notes.org" "Table B)) > ("tc" "add to table c" table-line (file+headline "~/notes.org" "Table C))) > > When starting capture, you can then first press "t" and then see > the individual options. This is great. Number of templates is constantly growing and the new features will increase the speed of this process. > 7 Request for comments > ~~~~~~~~~~~~~~~~~~~~~~~ > > None of what I describe is set in stone yet - let me know if you have > comments, change requests or other ideas. > > My feeling right now is that this should become the default capture > system, and that we will keep the current org-remember in the > distribution for quite some time, for compatibility. Good track I guess. Here's the tested and working patch for org-protocol.el. To use `org-remember' and/or `org-capture' alike, copy your org-remember link and change javascript:location.href='org-protocol://remember://'+... to javascript:location.href='org-protocol://capture://'+... The template char used is the same for both --- which is OK for me, but could be changed.
2010-06-22 10:20:13 -04:00
;; * Call `org-protocol-capture' by using the sub-protocol \"capture\". If
;; Org is loaded, Emacs will pop-up a capture buffer and fill the
;; template with the data provided. I.e. the browser's URL is inserted as an
;; Org-link of which the page title will be the description part. If text
2009-03-30 09:47:34 -04:00
;; was select in the browser, that text will be the body of the entry.
;;
;; You may use the same bookmark URL for all those standard handlers and just
;; adjust the sub-protocol used:
;;
;; location.href='org-protocol://sub-protocol?url='+
;; encodeURIComponent(location.href)+'&title='+
;; encodeURIComponent(document.title)+'&body='+
2009-03-30 09:47:34 -04:00
;; encodeURIComponent(window.getSelection())
;;
New implementation of the Org remember process ready for comments and testing Carsten Dominik <carsten.dominik@gmail.com> writes: > 3 Why a new name? > ~~~~~~~~~~~~~~~~~~ > > I have - at least for now - chosen a new name for the new setup: > ` org-capture'. There are two reasons for this: In the manual it is "Capture - Refile - Archive". I remember searching for "Remember" and never found it :) > 5 Setup > ~~~~~~~~ > > To use the new setup, do the following: > > 1. Run > > M-x org-capture-import-remember-templates RET Worked perfectly here :) I tested all my important templates and they work. Abandoning org-remember seems painless. > '(("t" "templates adding table lines") > ("ta" "add to table a" table-line (file+headline "~/notes.org" "Table A)) > ("tb" "add to table b" table-line (file+headline "~/notes.org" "Table B)) > ("tc" "add to table c" table-line (file+headline "~/notes.org" "Table C))) > > When starting capture, you can then first press "t" and then see > the individual options. This is great. Number of templates is constantly growing and the new features will increase the speed of this process. > 7 Request for comments > ~~~~~~~~~~~~~~~~~~~~~~~ > > None of what I describe is set in stone yet - let me know if you have > comments, change requests or other ideas. > > My feeling right now is that this should become the default capture > system, and that we will keep the current org-remember in the > distribution for quite some time, for compatibility. Good track I guess. Here's the tested and working patch for org-protocol.el. To use `org-remember' and/or `org-capture' alike, copy your org-remember link and change javascript:location.href='org-protocol://remember://'+... to javascript:location.href='org-protocol://capture://'+... The template char used is the same for both --- which is OK for me, but could be changed.
2010-06-22 10:20:13 -04:00
;; The handler for the sub-protocol \"capture\" detects an optional template
2009-03-30 09:47:34 -04:00
;; char that, if present, triggers the use of a special template.
;; Example:
;;
;; location.href='org-protocol://capture?template=x'+ ...
2009-03-30 09:47:34 -04:00
;;
;; uses template ?x.
2009-03-30 09:47:34 -04:00
;;
;; Note that using double slashes is optional from org-protocol.el's point of
2009-11-12 07:39:29 -05:00
;; view because emacsclient squashes the slashes to one.
2009-03-30 09:47:34 -04:00
;;
;;
;; provides: 'org-protocol
;;
;;; Code:
(require 'org)
Move link-related core functions out of "org.el" * contrib/lisp/org-wl.el (org-wl-store-link-message): * lisp/Makefile (clean-install): * lisp/ob-core.el (org-link-bracket-re): (org-babel-open-src-block-result): (org-babel-read-element): (org-babel-read-link): (org-babel-result-end): * lisp/ob-tangle.el (org-link-bracket-re): (org-babel-tangle-single-block): (org-link-analytic-bracket-re): (org-babel-detangle): (org-babel-tangle-jump-to-org): * lisp/ol.el: * lisp/org-agenda.el (org-agenda-get-some-entry-text): (org-diary): (org-agenda-format-item): (org-agenda-open-link): (org-agenda-switch-to): (org-agenda-to-appt): * lisp/org-bbdb.el (org-bbdb-store-link): * lisp/org-bibtex.el (org-bibtex-store-link): * lisp/org-capture.el (org-capture-fill-template): * lisp/org-clock.el (org-clocktable-write-default): (org-clock-get-table-data): * lisp/org-compat.el (org-doi-server-url): (org-email-link-description-format): (org-make-link-description-function): (org-from-is-user-regexp): (org-descriptive-links): (org-url-hexify-p): (org-context-in-file-links): (org-keep-stored-link-after-insertion): (org-display-internal-link-with-indirect-buffer): (org-confirm-shell-link-function): (org-confirm-shell-link-not-regexp): (org-confirm-elisp-link-function): (org-confirm-elisp-link-not-regexp): (org-file-complete-link): (org-email-link-description): (org-make-link-string): (org-store-link-props): (org-add-link-props): (org-make-link-regexps): (org-angle-link-re): (org-plain-link-re): (org-bracket-link-regexp): (org-bracket-link-analytic-regexp): (org-any-link-re): * lisp/org-docview.el (org-docview-store-link): (org-docview-complete-link): * lisp/org-element.el (org-element-link-parser): * lisp/org-eshell.el (org-eshell-store-link): * lisp/org-eww.el (org-eww-store-link): (org-eww-copy-for-org-mode): * lisp/org-footnote.el (org-footnote-next-reference-or-definition): * lisp/org-gnus.el (org-gnus-article-link): (org-gnus-store-link): * lisp/org-id.el (org-id-store-link): * lisp/org-info.el (org-info-store-link): * lisp/org-irc.el (org-irc-erc-store-link): * lisp/org-mhe.el (org-mhe-store-link): * lisp/org-pcomplete.el (pcomplete/org-mode/searchhead): * lisp/org-protocol.el (org-protocol-do-capture): * lisp/org-rmail.el (org-rmail-store-link): * lisp/org-w3m.el (org-w3m-store-link): (org-w3m-copy-for-org-mode):
2018-11-26 18:04:41 -05:00
(require 'ol)
2009-03-30 09:47:34 -04:00
Backport commit 65c8c7c from Emacs * lisp/ob-awk.el (orgtbl-to-generic): * lisp/ob-core.el (orgtbl-to-generic): * lisp/ob-exp.el (org-element-context): * lisp/ob-gnuplot.el (org-time-string-to-time) (orgtbl-to-generic): * lisp/ob-haskell.el (org-export-to-file): * lisp/ob-latex.el (org-create-formula-image) (org-latex-compile): * lisp/ob-python.el (run-python): * lisp/ob-tangle.el (org-link-escape, org-back-to-heading): * lisp/org-colview.el (org-agenda-redo): * lisp/org-feed.el (url-retrieve-synchronously): * lisp/org-info.el (Info-find-node): * lisp/org-list.el (org-previous-line-empty-p): * lisp/org-macs.el (org-string-match-p): * lisp/org.el (org-beamer-mode): Fix prototype to match current definition. * lisp/ob-comint.el (tramp-flush-directory-property): * lisp/ob-tangle.el (org-babel-update-block-body): * lisp/org-bibtex.el (org-babel-trim): * lisp/org-pcomplete.el (org-export-backend-options): * lisp/org-protocol.el (org-publish-get-project-from-filename): Fix file name in declare-function. * lisp/ob-comint.el (with-parsed-tramp-file-name) * lisp/ob-core.el (with-parsed-tramp-file-name): * lisp/org.el (org-beamer-mode): Append ‘t’ to declare-function, since the declaration isn’t a defun. * lisp/ob-core.el (org-save-outline-visibility): Remove; not needed. * lisp/ob-scheme.el (run-geiser, geiser-mode) (geiser-eval-region, geiser-repl-exit): * lisp/ox-org.el (htmlize-buffer): Prepend "ext:" to file name, since it is not part of Emacs. * lisp/org-gnus.el (nnimap-group-overview-filename): Remove decl, since function was removed. * lisp/org-macro.el (org-with-wide-buffer): Omit unnecessary (and mismatching) decl. * lisp/org-clock.el (calendar-iso-to-absolute): Declare calendar-iso-to-absolute instead, since it is the non-obsolete version of this function. * lisp/org-compat.el (w32-focus-frame): Remove decl, since function is now obsolete. Pacify ‘make check-declare’ 65c8c7cb96c14f9c6accd03cc8851b5a3459049e Paul Eggert Sat May 14 19:57:44 2016 -0700
2016-05-14 22:56:53 -04:00
(declare-function org-publish-get-project-from-filename "ox-publish"
(filename &optional up))
(declare-function server-edit "server" (&optional arg))
2016-06-21 17:36:31 -04:00
(defvar org-capture-link-is-already-stored)
(defvar org-capture-templates)
2016-06-21 17:36:31 -04:00
2009-03-30 09:47:34 -04:00
(defgroup org-protocol nil
"Intercept calls from emacsclient to trigger custom actions.
This is done by advising `server-visit-files' to scan the list of filenames
for `org-protocol-the-protocol' and sub-protocols defined in
2009-03-30 09:47:34 -04:00
`org-protocol-protocol-alist' and `org-protocol-protocol-alist-default'."
:version "22.1"
:group 'convenience
:group 'org)
;;; Variables:
(defconst org-protocol-protocol-alist-default
'(("org-capture" :protocol "capture" :function org-protocol-capture :kill-client t)
2009-03-30 09:47:34 -04:00
("org-store-link" :protocol "store-link" :function org-protocol-store-link)
("org-open-source" :protocol "open-source" :function org-protocol-open-source))
"Default protocols to use.
See `org-protocol-protocol-alist' for a description of this variable.")
(defconst org-protocol-the-protocol "org-protocol"
"This is the protocol to detect if org-protocol.el is loaded.
`org-protocol-protocol-alist-default' and `org-protocol-protocol-alist' hold
the sub-protocols that trigger the required action. You will have to define
just one protocol handler OS-wide (MS-Windows) or per application (Linux).
That protocol handler should call emacsclient.")
2009-03-30 09:47:34 -04:00
;;; User variables:
(defcustom org-protocol-reverse-list-of-files t
"Non-nil means re-reverse the list of filenames passed on the command line.
The filenames passed on the command line are passed to the emacs-server in
reverse order. Set to t (default) to re-reverse the list, i.e. use the
sequence on the command line. If nil, the sequence of the filenames is
2009-03-30 09:47:34 -04:00
unchanged."
:group 'org-protocol
:type 'boolean)
(defcustom org-protocol-project-alist nil
"Map URLs to local filenames for `org-protocol-open-source' (open-source).
2009-03-30 09:47:34 -04:00
Each element of this list must be of the form:
(module-name :property value property: value ...)
where module-name is an arbitrary name. All the values are strings.
2009-03-30 09:47:34 -04:00
Possible properties are:
:online-suffix - the suffix to strip from the published URLs
:working-suffix - the replacement for online-suffix
:base-url - the base URL, e.g. http://www.example.com/project/
Last slash required.
:working-directory - the local working directory. This is, what base-url will
2009-03-30 09:47:34 -04:00
be replaced with.
:redirects - A list of cons cells, each of which maps a regular
expression to match to a path relative to :working-directory.
2009-03-30 09:47:34 -04:00
Example:
(setq org-protocol-project-alist
\\='((\"https://orgmode.org/worg/\"
2009-03-30 09:47:34 -04:00
:online-suffix \".php\"
:working-suffix \".org\"
:base-url \"https://orgmode.org/worg/\"
2009-03-30 09:47:34 -04:00
:working-directory \"/home/user/org/Worg/\")
(\"localhost org-notes/\"
2009-03-30 09:47:34 -04:00
:online-suffix \".html\"
:working-suffix \".org\"
:base-url \"http://localhost/org/\"
:working-directory \"/home/user/org/\"
:rewrites ((\"org/?$\" . \"index.php\")))
(\"Hugo based blog\"
:base-url \"https://www.site.com/\"
:working-directory \"~/site/content/post/\"
:online-suffix \".html\"
:working-suffix \".md\"
:rewrites ((\"\\(https://site.com/[0-9]+/[0-9]+/[0-9]+/\\)\" . \".md\")))
(\"GNU emacs OpenGrok\"
:base-url \"https://opengrok.housegordon.com/source/xref/emacs/\"
:working-directory \"~/dev/gnu-emacs/\")))
The :rewrites line of \"localhost org-notes\" entry tells
`org-protocol-open-source' to open /home/user/org/index.php,
if the URL cannot be mapped to an existing file, and ends with
either \"org\" or \"org/\". The \"GNU emacs OpenGrok\" entry
does not include any suffix properties, allowing local source
file to be opened as found by OpenGrok.
2009-03-30 09:47:34 -04:00
Consider using the interactive functions `org-protocol-create' and
`org-protocol-create-for-org' to help you filling this variable with valid contents."
:group 'org-protocol
:type 'alist)
(defcustom org-protocol-protocol-alist nil
"Register custom handlers for org-protocol.
2009-03-30 09:47:34 -04:00
Each element of this list must be of the form:
2009-04-03 11:36:44 -04:00
(module-name :protocol protocol :function func :kill-client nil)
2009-03-30 09:47:34 -04:00
protocol - protocol to detect in a filename without trailing
colon and slashes. See rfc1738 section 2.1 for more
on this. If you define a protocol \"my-protocol\",
`org-protocol-check-filename-for-protocol' will search
filenames for \"org-protocol:/my-protocol\" and
trigger your action for every match. `org-protocol'
is defined in `org-protocol-the-protocol'. Double and
triple slashes are compressed to one by emacsclient.
function - function that handles requests with protocol and takes
one argument. If a new-style link (key=val&key2=val2)
is given, the argument will be a property list with
the values from the link. If an old-style link is
given (val1/val2), the argument will be the filename
with all protocols stripped.
If the function returns nil, emacsclient and -server
do nothing. Any non-nil return value is considered a
valid filename and thus passed to the server.
`org-protocol.el' provides some support for handling
old-style filenames, if you follow the conventions
used for the standard handlers in
`org-protocol-protocol-alist-default'. See
`org-protocol-parse-parameters'.
2009-03-30 09:47:34 -04:00
2009-04-03 11:36:44 -04:00
kill-client - If t, kill the client immediately, once the sub-protocol is
detected. This is necessary for actions that can be interrupted by
`C-g' to avoid dangling emacsclients. Note that all other command
line arguments but the this one will be discarded. Greedy handlers
2009-04-03 11:36:44 -04:00
still receive the whole list of arguments though.
2009-03-30 09:47:34 -04:00
Here is an example:
(setq org-protocol-protocol-alist
\\='((\"my-protocol\"
2009-03-30 09:47:34 -04:00
:protocol \"my-protocol\"
:function my-protocol-handler-function)
2009-03-30 09:47:34 -04:00
(\"your-protocol\"
:protocol \"your-protocol\"
:function your-protocol-handler-function)))"
2009-03-30 09:47:34 -04:00
:group 'org-protocol
:type '(alist))
(defcustom org-protocol-default-template-key nil
"The default template key to use.
This is usually a single character string but can also be a
string with two characters."
:group 'org-protocol
:type '(choice (const nil) (string)))
(defcustom org-protocol-data-separator "/+\\|\\?"
"The default data separator to use.
This should be a single regexp string."
:group 'org-protocol
:version "24.4"
:package-version '(Org . "8.0")
:type 'regexp)
2009-03-30 09:47:34 -04:00
;;; Helper functions:
(defun org-protocol-sanitize-uri (uri)
"Sanitize slashes to double-slashes in URI.
Emacsclient compresses double and triple slashes."
2009-03-30 09:47:34 -04:00
(when (string-match "^\\([a-z]+\\):/" uri)
(let* ((splitparts (split-string uri "/+")))
(setq uri (concat (car splitparts) "//" (mapconcat 'identity (cdr splitparts) "/")))))
uri)
(defun org-protocol-split-data (data &optional unhexify separator)
"Split the DATA argument for an org-protocol handler function.
If UNHEXIFY is non-nil, hex-decode each split part. If UNHEXIFY
is a function, use that function to decode each split part. The
string is split at each occurrence of SEPARATOR (regexp). If no
SEPARATOR is specified or SEPARATOR is nil, assume \"/+\". The
results of that splitting are returned as a list."
(let* ((sep (or separator "/+\\|\\?"))
2009-03-30 09:47:34 -04:00
(split-parts (split-string data sep)))
(cond ((not unhexify) split-parts)
((fboundp unhexify) (mapcar unhexify split-parts))
Change bracket link escape syntax * contrib/lisp/org-link-edit.el (org-link-edit--link-data): * lisp/ob-tangle.el (org-babel-tangle-comment-links): Update match-group. (org-babel-detangle): Remove unnecessary `org-link-escape' call. (org-babel-tangle-jump-to-org): Update match group. (org-link-url-hexify): (org-link-escape-chars): Remove variables. * lisp/ol.el (org-link--decode-compound): Renamed from `org-link--unescape-compound'. (org-link--decode-single-byte-sequence): Renamed from `org-link--unescape-single-byte-sequence'. (org-link-make-regexps): Update `org-link-bracket-re' syntax. (org-link-encode): New function, renamed from `org-link-escape'. (org-link-decode): New function, renamed from `org-link-unescape'. (org-link-escape): (org-link-unescape): Use new escape syntax. (org-link-make-string): Apply new escaping rules. (org-link-display-format): (org-insert-link): Update match group. * lisp/org-agenda.el (org-diary): (org-agenda-format-item): (org-agenda-to-appt): Update match group. * lisp/org-clock.el (org-clocktable-write-default): Update match group. * lisp/org-element.el (org-element-link-parser): Update match group. * lisp/org-mobile.el (org-mobile-escape-olp): (org-mobile-locate-entry): Apply function renaming. * lisp/org-protocol.el (org-protocol-split-data): (org-protocol-parse-parameters): Apply function renaming. * lisp/org.el (org-refile): Update match group. * testing/README (Interactive testing from within Emacs): Fix examples. * testing/lisp/test-ol.el (test-ol/encode): Merge old escape tests. (test-ol/decode): Merge old unescape tests. (test-ol/escape): (test-ol/unescape): (test-ol/make-string): New tests. * testing/lisp/test-org-clock.el (test-org-clock/clocktable/link): * testing/lisp/test-org.el (test-org/custom-id): (test-org/fuzzy-links): * testing/lisp/test-ox.el (test-org-export/resolve-fuzzy-link): Update tests.
2019-03-09 04:58:41 -05:00
(t (mapcar #'org-link-decode split-parts)))))
2009-03-30 09:47:34 -04:00
(defun org-protocol-flatten-greedy (param-list &optional strip-path replacement)
"Transform PARAM-LIST into a flat list for greedy handlers.
Greedy handlers might receive a list like this from emacsclient:
\((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\"))
where \"/dir/\" is the absolute path to emacsclient's working directory. This
function transforms it into a flat list using `org-protocol-flatten' and
transforms the elements of that list as follows:
If STRIP-PATH is non-nil, remove the \"/dir/\" prefix from all members of
param-list.
If REPLACEMENT is string, replace the \"/dir/\" prefix with it.
The first parameter, the one that contains the protocols, is always changed.
Everything up to the end of the protocols is stripped.
2009-04-05 09:28:31 -04:00
Note, that this function will always behave as if
`org-protocol-reverse-list-of-files' was set to t and the returned list will
reflect that. emacsclient's first parameter will be the first one in the
2009-04-05 09:28:31 -04:00
returned list."
(let* ((l (org-protocol-flatten (if org-protocol-reverse-list-of-files
param-list
(reverse param-list))))
(trigger (car l))
(len 0)
dir
ret)
(when (string-match "^\\(.*\\)\\(org-protocol:/+[a-zA-Z0-9][-_a-zA-Z0-9]*:/+\\)\\(.*\\)" trigger)
(setq dir (match-string 1 trigger))
(setq len (length dir))
(setcar l (concat dir (match-string 3 trigger))))
(if strip-path
(progn
(dolist (e l ret)
(setq ret
(append ret
(list
(if (stringp e)
(if (stringp replacement)
(setq e (concat replacement (substring e len)))
(setq e (substring e len)))
e)))))
ret)
l)))
(defalias 'org-protocol-flatten
(if (fboundp 'flatten-tree) 'flatten-tree
(lambda (list)
"Transform LIST into a flat list.
Greedy handlers might receive a list like this from emacsclient:
\((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\"))
2010-04-15 06:24:55 -04:00
where \"/dir/\" is the absolute path to emacsclients working directory.
This function transforms it into a flat list."
(if list
(if (consp list)
(append (org-protocol-flatten (car list))
(org-protocol-flatten (cdr list)))
(list list))))))
(defun org-protocol-parse-parameters (info &optional new-style default-order)
"Return a property list of parameters from INFO.
If NEW-STYLE is non-nil, treat INFO as a query string (ex:
url=URL&title=TITLE). If old-style links are used (ex:
org-protocol://store-link/url/title), assign them to attributes
following DEFAULT-ORDER.
If no DEFAULT-ORDER is specified, return the list of values.
If INFO is already a property list, return it unchanged."
(if (listp info)
info
(if new-style
(let ((data (org-protocol-convert-query-to-plist info))
result)
(while data
(setq result
(append result
Change bracket link escape syntax * contrib/lisp/org-link-edit.el (org-link-edit--link-data): * lisp/ob-tangle.el (org-babel-tangle-comment-links): Update match-group. (org-babel-detangle): Remove unnecessary `org-link-escape' call. (org-babel-tangle-jump-to-org): Update match group. (org-link-url-hexify): (org-link-escape-chars): Remove variables. * lisp/ol.el (org-link--decode-compound): Renamed from `org-link--unescape-compound'. (org-link--decode-single-byte-sequence): Renamed from `org-link--unescape-single-byte-sequence'. (org-link-make-regexps): Update `org-link-bracket-re' syntax. (org-link-encode): New function, renamed from `org-link-escape'. (org-link-decode): New function, renamed from `org-link-unescape'. (org-link-escape): (org-link-unescape): Use new escape syntax. (org-link-make-string): Apply new escaping rules. (org-link-display-format): (org-insert-link): Update match group. * lisp/org-agenda.el (org-diary): (org-agenda-format-item): (org-agenda-to-appt): Update match group. * lisp/org-clock.el (org-clocktable-write-default): Update match group. * lisp/org-element.el (org-element-link-parser): Update match group. * lisp/org-mobile.el (org-mobile-escape-olp): (org-mobile-locate-entry): Apply function renaming. * lisp/org-protocol.el (org-protocol-split-data): (org-protocol-parse-parameters): Apply function renaming. * lisp/org.el (org-refile): Update match group. * testing/README (Interactive testing from within Emacs): Fix examples. * testing/lisp/test-ol.el (test-ol/encode): Merge old escape tests. (test-ol/decode): Merge old unescape tests. (test-ol/escape): (test-ol/unescape): (test-ol/make-string): New tests. * testing/lisp/test-org-clock.el (test-org-clock/clocktable/link): * testing/lisp/test-org.el (test-org/custom-id): (test-org/fuzzy-links): * testing/lisp/test-ox.el (test-org-export/resolve-fuzzy-link): Update tests.
2019-03-09 04:58:41 -05:00
(list (pop data) (org-link-decode (pop data))))))
result)
(let ((data (org-protocol-split-data info t org-protocol-data-separator)))
(if default-order
(org-protocol-assign-parameters data default-order)
data)))))
(defun org-protocol-assign-parameters (data default-order)
"Return a property list of parameters from DATA.
Key names are taken from DEFAULT-ORDER, which should be a list of
symbols. If DEFAULT-ORDER is shorter than the number of values
specified, the rest of the values are treated as :key value pairs."
(let (result)
(while default-order
(setq result
(append result
(list (pop default-order)
(pop data)))))
(while data
(setq result
(append result
(list (intern (concat ":" (pop data)))
(pop data)))))
result))
2009-03-30 09:47:34 -04:00
;;; Standard protocol handlers:
(defun org-protocol-store-link (fname)
"Process an org-protocol://store-link style url.
Additionally store a browser URL as an org link. Also pushes the
link's URL to the `kill-ring'.
2009-03-30 09:47:34 -04:00
Parameters: url, title (optional), body (optional)
Old-style links such as org-protocol://store-link://URL/TITLE are
also recognized.
2009-03-30 09:47:34 -04:00
The location for a browser's bookmark has to look like this:
javascript:location.href = \\
\\='org-protocol://store-link?url=\\=' + \\
encodeURIComponent(location.href) + \\='&title=\\=' + \\
encodeURIComponent(document.title);
2009-03-30 09:47:34 -04:00
Don't use `escape()'! Use `encodeURIComponent()' instead. The
title of the page could contain slashes and the location
definitely will.
2009-03-30 09:47:34 -04:00
The sub-protocol used to reach this function is set in
`org-protocol-protocol-alist'.
FNAME should be a property list. If not, an old-style link of the
form URL/TITLE can also be used."
(let* ((splitparts (org-protocol-parse-parameters fname nil '(:url :title)))
(uri (org-protocol-sanitize-uri (plist-get splitparts :url)))
(title (plist-get splitparts :title)))
(when (boundp 'org-stored-links)
(push (list uri title) org-stored-links))
2009-03-30 09:47:34 -04:00
(kill-new uri)
(message "`%s' to insert new Org link, `%s' to insert %S"
(substitute-command-keys "\\[org-insert-link]")
(substitute-command-keys "\\[yank]")
2009-03-30 09:47:34 -04:00
uri))
nil)
(defun org-protocol-capture (info)
"Process an org-protocol://capture style url with INFO.
New implementation of the Org remember process ready for comments and testing Carsten Dominik <carsten.dominik@gmail.com> writes: > 3 Why a new name? > ~~~~~~~~~~~~~~~~~~ > > I have - at least for now - chosen a new name for the new setup: > ` org-capture'. There are two reasons for this: In the manual it is "Capture - Refile - Archive". I remember searching for "Remember" and never found it :) > 5 Setup > ~~~~~~~~ > > To use the new setup, do the following: > > 1. Run > > M-x org-capture-import-remember-templates RET Worked perfectly here :) I tested all my important templates and they work. Abandoning org-remember seems painless. > '(("t" "templates adding table lines") > ("ta" "add to table a" table-line (file+headline "~/notes.org" "Table A)) > ("tb" "add to table b" table-line (file+headline "~/notes.org" "Table B)) > ("tc" "add to table c" table-line (file+headline "~/notes.org" "Table C))) > > When starting capture, you can then first press "t" and then see > the individual options. This is great. Number of templates is constantly growing and the new features will increase the speed of this process. > 7 Request for comments > ~~~~~~~~~~~~~~~~~~~~~~~ > > None of what I describe is set in stone yet - let me know if you have > comments, change requests or other ideas. > > My feeling right now is that this should become the default capture > system, and that we will keep the current org-remember in the > distribution for quite some time, for compatibility. Good track I guess. Here's the tested and working patch for org-protocol.el. To use `org-remember' and/or `org-capture' alike, copy your org-remember link and change javascript:location.href='org-protocol://remember://'+... to javascript:location.href='org-protocol://capture://'+... The template char used is the same for both --- which is OK for me, but could be changed.
2010-06-22 10:20:13 -04:00
2009-03-30 09:47:34 -04:00
The sub-protocol used to reach this function is set in
`org-protocol-protocol-alist'.
This function detects an URL, title and optional text, separated
by `/'. The location for a browser's bookmark looks like this:
2009-03-30 09:47:34 -04:00
javascript:location.href = \\='org-protocol://capture?url=\\='+ \\
encodeURIComponent(location.href) + \\='&title=\\=' \\
encodeURIComponent(document.title) + \\='&body=\\=' + \\
2009-03-30 09:47:34 -04:00
encodeURIComponent(window.getSelection())
By default, it uses the character `org-protocol-default-template-key',
New implementation of the Org remember process ready for comments and testing Carsten Dominik <carsten.dominik@gmail.com> writes: > 3 Why a new name? > ~~~~~~~~~~~~~~~~~~ > > I have - at least for now - chosen a new name for the new setup: > ` org-capture'. There are two reasons for this: In the manual it is "Capture - Refile - Archive". I remember searching for "Remember" and never found it :) > 5 Setup > ~~~~~~~~ > > To use the new setup, do the following: > > 1. Run > > M-x org-capture-import-remember-templates RET Worked perfectly here :) I tested all my important templates and they work. Abandoning org-remember seems painless. > '(("t" "templates adding table lines") > ("ta" "add to table a" table-line (file+headline "~/notes.org" "Table A)) > ("tb" "add to table b" table-line (file+headline "~/notes.org" "Table B)) > ("tc" "add to table c" table-line (file+headline "~/notes.org" "Table C))) > > When starting capture, you can then first press "t" and then see > the individual options. This is great. Number of templates is constantly growing and the new features will increase the speed of this process. > 7 Request for comments > ~~~~~~~~~~~~~~~~~~~~~~~ > > None of what I describe is set in stone yet - let me know if you have > comments, change requests or other ideas. > > My feeling right now is that this should become the default capture > system, and that we will keep the current org-remember in the > distribution for quite some time, for compatibility. Good track I guess. Here's the tested and working patch for org-protocol.el. To use `org-remember' and/or `org-capture' alike, copy your org-remember link and change javascript:location.href='org-protocol://remember://'+... to javascript:location.href='org-protocol://capture://'+... The template char used is the same for both --- which is OK for me, but could be changed.
2010-06-22 10:20:13 -04:00
which should be associated with a template in `org-capture-templates'.
You may specify the template with a template= query parameter, like this:
2009-03-30 09:47:34 -04:00
javascript:location.href = \\='org-protocol://capture?template=b\\='+ ...
2009-03-30 09:47:34 -04:00
Now template ?b will be used."
(let* ((parts
(pcase (org-protocol-parse-parameters info)
;; New style links are parsed as a plist.
((let `(,(pred keywordp) . ,_) info) info)
;; Old style links, with or without template key, are
;; parsed as a list of strings.
(p
(let ((k (if (= 1 (length (car p)))
'(:template :url :title :body)
'(:url :title :body))))
(org-protocol-assign-parameters p k)))))
(template (or (plist-get parts :template)
New implementation of the Org remember process ready for comments and testing Carsten Dominik <carsten.dominik@gmail.com> writes: > 3 Why a new name? > ~~~~~~~~~~~~~~~~~~ > > I have - at least for now - chosen a new name for the new setup: > ` org-capture'. There are two reasons for this: In the manual it is "Capture - Refile - Archive". I remember searching for "Remember" and never found it :) > 5 Setup > ~~~~~~~~ > > To use the new setup, do the following: > > 1. Run > > M-x org-capture-import-remember-templates RET Worked perfectly here :) I tested all my important templates and they work. Abandoning org-remember seems painless. > '(("t" "templates adding table lines") > ("ta" "add to table a" table-line (file+headline "~/notes.org" "Table A)) > ("tb" "add to table b" table-line (file+headline "~/notes.org" "Table B)) > ("tc" "add to table c" table-line (file+headline "~/notes.org" "Table C))) > > When starting capture, you can then first press "t" and then see > the individual options. This is great. Number of templates is constantly growing and the new features will increase the speed of this process. > 7 Request for comments > ~~~~~~~~~~~~~~~~~~~~~~~ > > None of what I describe is set in stone yet - let me know if you have > comments, change requests or other ideas. > > My feeling right now is that this should become the default capture > system, and that we will keep the current org-remember in the > distribution for quite some time, for compatibility. Good track I guess. Here's the tested and working patch for org-protocol.el. To use `org-remember' and/or `org-capture' alike, copy your org-remember link and change javascript:location.href='org-protocol://remember://'+... to javascript:location.href='org-protocol://capture://'+... The template char used is the same for both --- which is OK for me, but could be changed.
2010-06-22 10:20:13 -04:00
org-protocol-default-template-key))
(url (and (plist-get parts :url)
(org-protocol-sanitize-uri (plist-get parts :url))))
(type (and url
(string-match "^\\([a-z]+\\):" url)
(match-string 1 url)))
(title (or (plist-get parts :title) ""))
(region (or (plist-get parts :body) ""))
(orglink
(if (null url) title
Move link-related core functions out of "org.el" * contrib/lisp/org-wl.el (org-wl-store-link-message): * lisp/Makefile (clean-install): * lisp/ob-core.el (org-link-bracket-re): (org-babel-open-src-block-result): (org-babel-read-element): (org-babel-read-link): (org-babel-result-end): * lisp/ob-tangle.el (org-link-bracket-re): (org-babel-tangle-single-block): (org-link-analytic-bracket-re): (org-babel-detangle): (org-babel-tangle-jump-to-org): * lisp/ol.el: * lisp/org-agenda.el (org-agenda-get-some-entry-text): (org-diary): (org-agenda-format-item): (org-agenda-open-link): (org-agenda-switch-to): (org-agenda-to-appt): * lisp/org-bbdb.el (org-bbdb-store-link): * lisp/org-bibtex.el (org-bibtex-store-link): * lisp/org-capture.el (org-capture-fill-template): * lisp/org-clock.el (org-clocktable-write-default): (org-clock-get-table-data): * lisp/org-compat.el (org-doi-server-url): (org-email-link-description-format): (org-make-link-description-function): (org-from-is-user-regexp): (org-descriptive-links): (org-url-hexify-p): (org-context-in-file-links): (org-keep-stored-link-after-insertion): (org-display-internal-link-with-indirect-buffer): (org-confirm-shell-link-function): (org-confirm-shell-link-not-regexp): (org-confirm-elisp-link-function): (org-confirm-elisp-link-not-regexp): (org-file-complete-link): (org-email-link-description): (org-make-link-string): (org-store-link-props): (org-add-link-props): (org-make-link-regexps): (org-angle-link-re): (org-plain-link-re): (org-bracket-link-regexp): (org-bracket-link-analytic-regexp): (org-any-link-re): * lisp/org-docview.el (org-docview-store-link): (org-docview-complete-link): * lisp/org-element.el (org-element-link-parser): * lisp/org-eshell.el (org-eshell-store-link): * lisp/org-eww.el (org-eww-store-link): (org-eww-copy-for-org-mode): * lisp/org-footnote.el (org-footnote-next-reference-or-definition): * lisp/org-gnus.el (org-gnus-article-link): (org-gnus-store-link): * lisp/org-id.el (org-id-store-link): * lisp/org-info.el (org-info-store-link): * lisp/org-irc.el (org-irc-erc-store-link): * lisp/org-mhe.el (org-mhe-store-link): * lisp/org-pcomplete.el (pcomplete/org-mode/searchhead): * lisp/org-protocol.el (org-protocol-do-capture): * lisp/org-rmail.el (org-rmail-store-link): * lisp/org-w3m.el (org-w3m-store-link): (org-w3m-copy-for-org-mode):
2018-11-26 18:04:41 -05:00
(org-link-make-string url (or (org-string-nw-p title) url))))
;; Avoid call to `org-store-link'.
(org-capture-link-is-already-stored t))
;; Only store link if there's a URL to insert later on.
(when url (push (list url title) org-stored-links))
Move link-related core functions out of "org.el" * contrib/lisp/org-wl.el (org-wl-store-link-message): * lisp/Makefile (clean-install): * lisp/ob-core.el (org-link-bracket-re): (org-babel-open-src-block-result): (org-babel-read-element): (org-babel-read-link): (org-babel-result-end): * lisp/ob-tangle.el (org-link-bracket-re): (org-babel-tangle-single-block): (org-link-analytic-bracket-re): (org-babel-detangle): (org-babel-tangle-jump-to-org): * lisp/ol.el: * lisp/org-agenda.el (org-agenda-get-some-entry-text): (org-diary): (org-agenda-format-item): (org-agenda-open-link): (org-agenda-switch-to): (org-agenda-to-appt): * lisp/org-bbdb.el (org-bbdb-store-link): * lisp/org-bibtex.el (org-bibtex-store-link): * lisp/org-capture.el (org-capture-fill-template): * lisp/org-clock.el (org-clocktable-write-default): (org-clock-get-table-data): * lisp/org-compat.el (org-doi-server-url): (org-email-link-description-format): (org-make-link-description-function): (org-from-is-user-regexp): (org-descriptive-links): (org-url-hexify-p): (org-context-in-file-links): (org-keep-stored-link-after-insertion): (org-display-internal-link-with-indirect-buffer): (org-confirm-shell-link-function): (org-confirm-shell-link-not-regexp): (org-confirm-elisp-link-function): (org-confirm-elisp-link-not-regexp): (org-file-complete-link): (org-email-link-description): (org-make-link-string): (org-store-link-props): (org-add-link-props): (org-make-link-regexps): (org-angle-link-re): (org-plain-link-re): (org-bracket-link-regexp): (org-bracket-link-analytic-regexp): (org-any-link-re): * lisp/org-docview.el (org-docview-store-link): (org-docview-complete-link): * lisp/org-element.el (org-element-link-parser): * lisp/org-eshell.el (org-eshell-store-link): * lisp/org-eww.el (org-eww-store-link): (org-eww-copy-for-org-mode): * lisp/org-footnote.el (org-footnote-next-reference-or-definition): * lisp/org-gnus.el (org-gnus-article-link): (org-gnus-store-link): * lisp/org-id.el (org-id-store-link): * lisp/org-info.el (org-info-store-link): * lisp/org-irc.el (org-irc-erc-store-link): * lisp/org-mhe.el (org-mhe-store-link): * lisp/org-pcomplete.el (pcomplete/org-mode/searchhead): * lisp/org-protocol.el (org-protocol-do-capture): * lisp/org-rmail.el (org-rmail-store-link): * lisp/org-w3m.el (org-w3m-store-link): (org-w3m-copy-for-org-mode):
2018-11-26 18:04:41 -05:00
(org-link-store-props :type type
New implementation of the Org remember process ready for comments and testing Carsten Dominik <carsten.dominik@gmail.com> writes: > 3 Why a new name? > ~~~~~~~~~~~~~~~~~~ > > I have - at least for now - chosen a new name for the new setup: > ` org-capture'. There are two reasons for this: In the manual it is "Capture - Refile - Archive". I remember searching for "Remember" and never found it :) > 5 Setup > ~~~~~~~~ > > To use the new setup, do the following: > > 1. Run > > M-x org-capture-import-remember-templates RET Worked perfectly here :) I tested all my important templates and they work. Abandoning org-remember seems painless. > '(("t" "templates adding table lines") > ("ta" "add to table a" table-line (file+headline "~/notes.org" "Table A)) > ("tb" "add to table b" table-line (file+headline "~/notes.org" "Table B)) > ("tc" "add to table c" table-line (file+headline "~/notes.org" "Table C))) > > When starting capture, you can then first press "t" and then see > the individual options. This is great. Number of templates is constantly growing and the new features will increase the speed of this process. > 7 Request for comments > ~~~~~~~~~~~~~~~~~~~~~~~ > > None of what I describe is set in stone yet - let me know if you have > comments, change requests or other ideas. > > My feeling right now is that this should become the default capture > system, and that we will keep the current org-remember in the > distribution for quite some time, for compatibility. Good track I guess. Here's the tested and working patch for org-protocol.el. To use `org-remember' and/or `org-capture' alike, copy your org-remember link and change javascript:location.href='org-protocol://remember://'+... to javascript:location.href='org-protocol://capture://'+... The template char used is the same for both --- which is OK for me, but could be changed.
2010-06-22 10:20:13 -04:00
:link url
:description title
:annotation orglink
:initial region
:query parts)
New implementation of the Org remember process ready for comments and testing Carsten Dominik <carsten.dominik@gmail.com> writes: > 3 Why a new name? > ~~~~~~~~~~~~~~~~~~ > > I have - at least for now - chosen a new name for the new setup: > ` org-capture'. There are two reasons for this: In the manual it is "Capture - Refile - Archive". I remember searching for "Remember" and never found it :) > 5 Setup > ~~~~~~~~ > > To use the new setup, do the following: > > 1. Run > > M-x org-capture-import-remember-templates RET Worked perfectly here :) I tested all my important templates and they work. Abandoning org-remember seems painless. > '(("t" "templates adding table lines") > ("ta" "add to table a" table-line (file+headline "~/notes.org" "Table A)) > ("tb" "add to table b" table-line (file+headline "~/notes.org" "Table B)) > ("tc" "add to table c" table-line (file+headline "~/notes.org" "Table C))) > > When starting capture, you can then first press "t" and then see > the individual options. This is great. Number of templates is constantly growing and the new features will increase the speed of this process. > 7 Request for comments > ~~~~~~~~~~~~~~~~~~~~~~~ > > None of what I describe is set in stone yet - let me know if you have > comments, change requests or other ideas. > > My feeling right now is that this should become the default capture > system, and that we will keep the current org-remember in the > distribution for quite some time, for compatibility. Good track I guess. Here's the tested and working patch for org-protocol.el. To use `org-remember' and/or `org-capture' alike, copy your org-remember link and change javascript:location.href='org-protocol://remember://'+... to javascript:location.href='org-protocol://capture://'+... The template char used is the same for both --- which is OK for me, but could be changed.
2010-06-22 10:20:13 -04:00
(raise-frame)
(org-capture nil template)
(message "Item captured.")
;; Make sure we do not return a string, as `server-visit-files',
;; through `server-edit', would interpret it as a file name.
nil))
(defun org-protocol-convert-query-to-plist (query)
"Convert QUERY key=value pairs in the URL to a property list."
(when query
(apply 'append (mapcar (lambda (x)
(let ((c (split-string x "=")))
(list (intern (concat ":" (car c))) (cadr c))))
(split-string query "&")))))
New implementation of the Org remember process ready for comments and testing Carsten Dominik <carsten.dominik@gmail.com> writes: > 3 Why a new name? > ~~~~~~~~~~~~~~~~~~ > > I have - at least for now - chosen a new name for the new setup: > ` org-capture'. There are two reasons for this: In the manual it is "Capture - Refile - Archive". I remember searching for "Remember" and never found it :) > 5 Setup > ~~~~~~~~ > > To use the new setup, do the following: > > 1. Run > > M-x org-capture-import-remember-templates RET Worked perfectly here :) I tested all my important templates and they work. Abandoning org-remember seems painless. > '(("t" "templates adding table lines") > ("ta" "add to table a" table-line (file+headline "~/notes.org" "Table A)) > ("tb" "add to table b" table-line (file+headline "~/notes.org" "Table B)) > ("tc" "add to table c" table-line (file+headline "~/notes.org" "Table C))) > > When starting capture, you can then first press "t" and then see > the individual options. This is great. Number of templates is constantly growing and the new features will increase the speed of this process. > 7 Request for comments > ~~~~~~~~~~~~~~~~~~~~~~~ > > None of what I describe is set in stone yet - let me know if you have > comments, change requests or other ideas. > > My feeling right now is that this should become the default capture > system, and that we will keep the current org-remember in the > distribution for quite some time, for compatibility. Good track I guess. Here's the tested and working patch for org-protocol.el. To use `org-remember' and/or `org-capture' alike, copy your org-remember link and change javascript:location.href='org-protocol://remember://'+... to javascript:location.href='org-protocol://capture://'+... The template char used is the same for both --- which is OK for me, but could be changed.
2010-06-22 10:20:13 -04:00
2009-03-30 09:47:34 -04:00
(defun org-protocol-open-source (fname)
"Process an org-protocol://open-source?url= style URL with FNAME.
2009-03-30 09:47:34 -04:00
Change a filename by mapping URLs to local filenames as set
in `org-protocol-project-alist'.
The location for a browser's bookmark should look like this:
javascript:location.href = \\='org-protocol://open-source?url=\\=' + \\
2009-03-30 09:47:34 -04:00
encodeURIComponent(location.href)"
;; As we enter this function for a match on our protocol, the return value
;; defaults to nil.
(let ((result nil)
(f (org-protocol-sanitize-uri
(plist-get (org-protocol-parse-parameters fname nil '(:url))
:url))))
2009-03-30 09:47:34 -04:00
(catch 'result
(dolist (prolist org-protocol-project-alist)
(let* ((base-url (plist-get (cdr prolist) :base-url))
(wsearch (regexp-quote base-url)))
(when (string-match wsearch f)
(let* ((wdir (plist-get (cdr prolist) :working-directory))
(strip-suffix (plist-get (cdr prolist) :online-suffix))
(add-suffix (plist-get (cdr prolist) :working-suffix))
;; Strip "[?#].*$" if `f' is a redirect with another
;; ending than strip-suffix here:
(f1 (substring f 0 (string-match "\\([\\?#].*\\)?$" f)))
(start-pos (+ (string-match wsearch f1) (length base-url)))
(end-pos (if strip-suffix
(string-match (regexp-quote strip-suffix) f1)
(length f1)))
;; We have to compare redirects without suffix below:
(f2 (concat wdir (substring f1 start-pos end-pos)))
(the-file (if add-suffix (concat f2 add-suffix) f2)))
;; Note: the-file may still contain `%C3' et al here because browsers
;; tend to encode `&auml;' in URLs to `%25C3' - `%25' being `%'.
;; So the results may vary.
;; -- start redirects --
(unless (file-exists-p the-file)
(message "File %s does not exist.\nTesting for rewritten URLs." the-file)
(let ((rewrites (plist-get (cdr prolist) :rewrites)))
(when rewrites
(message "Rewrites found: %S" rewrites)
(dolist (rewrite rewrites)
;; Try to match a rewritten URL and map it to
;; a real file. Compare redirects without
;; suffix.
(when (string-match (car rewrite) f1)
(let ((replacement
(concat (directory-file-name
(replace-match "" nil nil f1 1))
(cdr rewrite))))
(throw 'result (concat wdir replacement))))))))
;; -- end of redirects --
2009-03-30 09:47:34 -04:00
(if (file-readable-p the-file)
(throw 'result the-file))
(if (file-exists-p the-file)
(message "%s: permission denied!" the-file)
(message "%s: no such file or directory." the-file))))))
result)))
;;; Core functions:
(defun org-protocol-check-filename-for-protocol (fname restoffiles _client)
"Check if `org-protocol-the-protocol' and a valid protocol are used in FNAME.
2009-03-30 09:47:34 -04:00
Sub-protocols are registered in `org-protocol-protocol-alist' and
`org-protocol-protocol-alist-default'. This is how the matching is done:
2009-03-30 09:47:34 -04:00
(string-match \"protocol:/+sub-protocol\\\\(://\\\\|\\\\?\\\\)\" ...)
2009-03-30 09:47:34 -04:00
protocol and sub-protocol are regexp-quoted.
Old-style links such as \"protocol://sub-protocol://param1/param2\" are
also recognized.
If a matching protocol is found, the protocol is stripped from
fname and the result is passed to the protocol function as the
first parameter. The second parameter will be non-nil if FNAME
uses key=val&key2=val2-type arguments, or nil if FNAME uses
val/val2-type arguments. If the function returns nil, the
filename is removed from the list of filenames passed from
emacsclient to the server. If the function returns a non-nil
value, that value is passed to the server as filename.
If the handler function is greedy, RESTOFFILES will also be passed to it.
CLIENT is ignored."
(let ((sub-protocols (append org-protocol-protocol-alist
org-protocol-protocol-alist-default)))
2009-03-30 09:47:34 -04:00
(catch 'fname
(let ((the-protocol (concat (regexp-quote org-protocol-the-protocol)
":/+")))
2009-03-30 09:47:34 -04:00
(when (string-match the-protocol fname)
(dolist (prolist sub-protocols)
(let ((proto
(concat the-protocol
(regexp-quote (plist-get (cdr prolist) :protocol))
"\\(:/+\\|/*\\?\\)")))
2009-03-30 09:47:34 -04:00
(when (string-match proto fname)
(let* ((func (plist-get (cdr prolist) :function))
(greedy (plist-get (cdr prolist) :greedy))
(split (split-string fname proto))
(result (if greedy restoffiles (cadr split)))
(new-style (string-match "/*?" (match-string 1 fname))))
(when (plist-get (cdr prolist) :kill-client)
(message "Greedy org-protocol handler. Killing client.")
(server-edit))
2009-03-30 09:47:34 -04:00
(when (fboundp func)
(unless greedy
(throw 'fname
(if new-style
(funcall func (org-protocol-parse-parameters
result new-style))
(warn "Please update your Org Protocol handler \
to deal with new-style links.")
(funcall func result))))
;; Greedy protocol handlers are responsible for
;; parsing their own filenames.
(funcall func result)
2009-03-30 09:47:34 -04:00
(throw 'fname t))))))))
fname)))
(defadvice server-visit-files (before org-protocol-detect-protocol-server activate)
"Advice server-visit-flist to call `org-protocol-modify-filename-for-protocol'."
(let ((flist (if org-protocol-reverse-list-of-files
(reverse (ad-get-arg 0))
2009-04-03 11:36:44 -04:00
(ad-get-arg 0)))
(client (ad-get-arg 1)))
2009-03-30 09:47:34 -04:00
(catch 'greedy
(dolist (var flist)
;; `\' to `/' on windows. FIXME: could this be done any better?
(let ((fname (expand-file-name (car var))))
(setq fname (org-protocol-check-filename-for-protocol
fname (member var flist) client))
(if (eq fname t) ;; greedy? We need the t return value.
2009-03-30 09:47:34 -04:00
(progn
(ad-set-arg 0 nil)
(throw 'greedy t))
(if (stringp fname) ;; probably filename
(setcar var fname)
(ad-set-arg 0 (delq var (ad-get-arg 0))))))))))
2009-03-30 09:47:34 -04:00
;;; Org specific functions:
(defun org-protocol-create-for-org ()
"Create an Org protocol project for the current file's project.
The visited file needs to be part of a publishing project in
`org-publish-project-alist' for this to work. The function
delegates most of the work to `org-protocol-create'."
2009-03-30 09:47:34 -04:00
(interactive)
(require 'ox-publish)
2009-03-30 09:47:34 -04:00
(let ((all (or (org-publish-get-project-from-filename buffer-file-name))))
(if all (org-protocol-create (cdr all))
(message "%s"
(substitute-command-keys
"Not in an Org project. \
Did you mean `\\[org-protocol-create]'?")))))
2009-03-30 09:47:34 -04:00
(defun org-protocol-create (&optional project-plist)
2009-03-30 09:47:34 -04:00
"Create a new org-protocol project interactively.
An org-protocol project is an entry in
`org-protocol-project-alist' which is used by
`org-protocol-open-source'. Optionally use PROJECT-PLIST to
initialize the defaults for this project. If PROJECT-PLIST is
the cdr of an element in `org-publish-project-alist', reuse
2009-03-30 09:47:34 -04:00
:base-directory, :html-extension and :base-extension."
(interactive)
(let ((working-dir (expand-file-name
(or (plist-get project-plist :base-directory)
default-directory)))
(base-url "https://orgmode.org/worg/")
2009-03-30 09:47:34 -04:00
(strip-suffix (or (plist-get project-plist :html-extension) ".html"))
(working-suffix (if (plist-get project-plist :base-extension)
(concat "." (plist-get project-plist :base-extension))
".org"))
(insert-default-directory t)
(minibuffer-allow-text-properties nil))
(setq base-url (read-string "Base URL of published content: " base-url nil base-url t))
(or (string-suffix-p "/" base-url)
(setq base-url (concat base-url "/")))
2009-03-30 09:47:34 -04:00
(setq working-dir
(expand-file-name
(read-directory-name "Local working directory: " working-dir working-dir t)))
(or (string-suffix-p "/" working-dir)
(setq working-dir (concat working-dir "/")))
2009-03-30 09:47:34 -04:00
(setq strip-suffix
(read-string
(concat "Extension to strip from published URLs (" strip-suffix "): ")
strip-suffix nil strip-suffix t))
2009-03-30 09:47:34 -04:00
(setq working-suffix
(read-string
(concat "Extension of editable files (" working-suffix "): ")
working-suffix nil working-suffix t))
2009-03-30 09:47:34 -04:00
(when (yes-or-no-p "Save the new org-protocol-project to your init file? ")
2009-03-30 09:47:34 -04:00
(setq org-protocol-project-alist
(cons `(,base-url . (:base-url ,base-url
:working-directory ,working-dir
:online-suffix ,strip-suffix
:working-suffix ,working-suffix))
2009-03-30 09:47:34 -04:00
org-protocol-project-alist))
(customize-save-variable 'org-protocol-project-alist org-protocol-project-alist))))
2009-03-30 09:47:34 -04:00
(provide 'org-protocol)
2009-03-30 09:47:34 -04:00
;;; org-protocol.el ends here