diff --git a/Makefile b/Makefile index 41fa61d0c..edc4f7b16 100644 --- a/Makefile +++ b/Makefile @@ -88,6 +88,7 @@ LISPF = org.el \ org-mouse.el \ org-publish.el \ org-plot.el \ + org-protocol.el \ org-remember.el \ org-rmail.el \ org-table.el \ @@ -340,6 +341,7 @@ lisp/org-mhe.elc: lisp/org.el lisp/org-mouse.elc: lisp/org.el lisp/org-plot.elc: lisp/org.el lisp/org-exp.el lisp/org-table.el lisp/org-publish.elc: +lisp/org-protocol.elc: lisp/org.el lisp/org-remember.elc: lisp/org.el lisp/org-rmail.elc: lisp/org.el lisp/org-table.elc: lisp/org.el diff --git a/lisp/org-protocol.el b/lisp/org-protocol.el new file mode 100644 index 000000000..addbb8740 --- /dev/null +++ b/lisp/org-protocol.el @@ -0,0 +1,512 @@ +;;; org-protocol.el --- Intercept calls from emacsclient to trigger custom actions. +;; +;; Copyright (c) 2008, 2009 +;; Bastien Guerry , +;; Daniel German , +;; Sebastian Rose , +;; Ross Patterson +;; David Moffat +;; (will be FSF when done) +;; +;; +;; Filename: org-protocol.el +;; Version: 0.1.0 +;; Author: Bastien Guerry +;; Author: Daniel M German +;; Author: Sebastian Rose +;; Author: Ross Patterson +;; Maintainer: Sebastian Rose +;; Keywords: org, emacsclient, wp + +;; This file is not part of GNU Emacs. + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program 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. + +;; See . + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Commentary: +;; +;; Intercept calls from emacsclient to trigger custom actions. +;; +;; This is done by advising `server-visit-files' to scann the list of filenames +;; for `org-protocol-the-protocol' and sub-procols defined in +;; `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://http:%2F%2Flocalhost%2Findex.html/The%20title +;; +;; 5.) Optionally add custom sub-protocols and handlers: +;; +;; (setq org-protocol-protocol-alist +;; '(("my-protocol" +;; :protocol "my-protocol" +;; :function my-protocol-handler-fuction))) +;; +;; A "sub-protocol" will be found in URLs like this: +;; +;; org-protocol://sub-protocol://data +;; +;; 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-mode is present) and +;; pushes the browsers URL to the `kill-ring' for yanking. This handler is +;; triggered through the sub-protocol \"store-link\". +;; +;; * Call `org-protocol-remember' by using the sub-protocol \"remember\". If +;; Org-mode is loaded, emacs will popup a remember 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 +;; 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://'+ +;; encodeURIComponent(location.href)+'/'+ +;; encodeURIComponent(document.title)+'/'+ +;; encodeURIComponent(window.getSelection()) +;; +;; The handler for the sub-protocol \"remember\" detects an optional template +;; char that, if present, triggers the use of a special template. +;; Example: +;; +;; location.href='org-protocol://sub-protocol://x/'+ ... +;; +;; use template ?x. +;; +;; Note, that using double shlashes is optional from org-protocol.el's point of +;; view because emacsclient sqashes the slashes to one. +;; +;; +;; provides: 'org-protocol +;; +;;; Code: + +(require 'org) +(require 'url) + + +(defgroup org-protocol nil + "Intercept calls from emacsclient to trigger custom actions. + +This is done by advising `server-visit-files' to scann the list of filenames +for `org-protocol-the-protocol' and sub-procols defined in +`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-remember" :protocol "remember" :function org-protocol-remember) + ("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.") + + +;;; User variables: + +(defcustom org-protocol-reverse-list-of-files t + "* The filenames passed on the commandline are passed to the emacs-server in +reversed 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 +unchanged." + :group 'org-protocol + :type 'boolean) + + +(defcustom org-protocol-project-alist nil + "* Map URLs to local filenames for `org-protocol-open-source' (open-source). + +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. + +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 + be replaced with. + +Example: + + (setq org-protocol-project-alist + '((\"http://orgmode.org/worg/\" + :online-suffix \".php\" + :working-suffix \".org\" + :base-url \"http://orgmode.org/worg/\" + :working-directory \"/home/user/org/Worg/\") + (\"http://localhost/org-notes/\" + :online-suffix \".html\" + :working-suffix \".org\" + :base-url \"http://localhost/org/\" + :working-directory \"/home/user/org/\"))) + +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. + +Each element of this list must be of the form: + + (module-name :protocol protocol :function func) + +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 tripple slashes are compressed + to one by emacsclient. + +function - function that handles requests with protocol and takes exactly one + argument: 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 those filenames, + if you stay with the conventions used for the standard handlers in + `org-protocol-protocol-alist-default'. See `org-protocol-split-data'. + +Here is an example: + + (setq org-protocol-protocol-alist + '((\"my-protocol\" + :protocol \"my-protocol\" + :function my-protocol-handler-fuction) + (\"your-protocol\" + :protocol \"your-protocol\" + :function your-protocol-handler-fuction)))" + :group 'org-protocol + :type '(alist)) + + +;;; Helper functions: + +(defun org-protocol-sanitize-uri (uri) + "emacsclient compresses double and tripple slashes. +Slashes are sanitized to double slashes here." + (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, what a org-protocol handler function gets as only argument. +data is that one argument. Data is splitted at each occurrence of separator + (regexp). If no separator is specified or separator is nil, assume \"/+\". +The results of that splitting are return as a list. If unhexify is non-nil, +hex-decode each split part." + (let* ((sep (or separator "/+")) + (split-parts (split-string data sep))) + (if unhexify + (mapcar 'url-unhex-string split-parts) + split-parts))) + + +;;; Standard protocol handlers: + +(defun org-protocol-store-link (fname) + "Process an org-protocol://store-link:// style url +and store a browser URL as an org link. Also pushes the links URL to the +`kill-ring'. + +The location for a browser's bookmark has to look like this: + + javascript:location.href='org-protocol://store-link://'+ \\ + encodeURIComponent(location.href) + encodeURIComponent(document.title)+'/'+ \\ + +Don't use `escape()'! Use `encodeURIComponent()' instead. The title of the page +could contain slashes and the location definitely will. + +The sub-protocol used to reach this function is set in +`org-protocol-protocol-alist'." + (let* ((splitparts (org-protocol-split-data fname t)) + (uri (org-protocol-sanitize-uri (car splitparts))) + (title (cadr splitparts)) + orglink) + (if (boundp 'org-stored-links) + (setq org-stored-links (cons (list uri title) org-stored-links))) + (kill-new uri) + (message "`%s' to insert new org-link, `%s' to insert `%s'" + (substitute-command-keys"\\[org-insert-link]") + (substitute-command-keys"\\[yank]") + uri)) + nil) + + +(defun org-protocol-remember (info) + "Process an org-protocol://remember:// style url. + +The sub-protocol used to reach this function is set in +`org-protocol-protocol-alist'. + +This function detects an URL, title and optinal text, separated by '/' +The location for a browser's bookmark has to look like this: + + javascript:location.href='org-protocol://remember://'+ \\ + encodeURIComponent(location.href)+ \\ + encodeURIComponent(document.title)+'/'+ \\ + encodeURIComponent(window.getSelection()) + +By default the template character ?w is used. But you may prepend the encoded +URL with a character and a slash like so: + + javascript:location.href='org-protocol://org-store-link://b/'+ ... + +Now template ?b will be used." + + (if (and (boundp 'org-stored-links) + (fboundp 'org-remember)) + (let* ((b (generate-new-buffer "*org-protocol*")) + (parts (org-protocol-split-data info t)) + (template (or (and (= 1 (length (car parts))) (pop parts)) "w")) + (url (org-protocol-sanitize-uri (car parts))) + (type (if (string-match "^\\([a-z]+\\):" url) + (match-string 1 url))) + (title (cadr parts)) + (region (caddr parts)) + orglink) + (setq orglink (org-make-link-string url title)) + (org-store-link-props :type type + :link url + :region region + :description title) + (setq org-stored-links + (cons (list url title) org-stored-links)) + ;; FIXME can't access %a in the template -- how to set annotation? + (raise-frame) + (kill-new orglink) + (set-buffer b) + (insert region) + (mark-whole-buffer) + (org-remember nil (string-to-char template)) + (kill-buffer b)) + (message "Org-mode not loaded.")) + nil) + + +(defun org-protocol-open-source (fname) + "Process an org-protocol://open-source:// style url. + +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://'+ \\ + encodeURIComponent(location.href)" + + ;; As we enter this function for a match on our protocol, the return value + ;; defaults to nil. + (let ((result nil) + (f (url-unhex-string fname))) + (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)) + (start-pos (+ (string-match wsearch f) (length base-url))) + (end-pos (string-match + (concat (regexp-quote strip-suffix) "\\([?#].*\\)?$") f)) + (the-file (concat wdir (substring f start-pos end-pos) add-suffix))) + (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) + "Detect if `org-protocol-the-protocol' and a known sub-protocol is used in fname. +Sub-protocols are registered in `org-protocol-protocol-alist' and +`org-protocol-protocol-alist-default'. +This is, how the matching is done: + + (string-match \"protocol:/+sub-protocol:/+\" ...) + +protocol and sub-protocol are regexp-quoted. + +If a matching protcol is found, the protcol is stripped from fname and the +result is passed to the protocols function as the only parameter. 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." + (let ((sub-protocols (append org-protocol-protocol-alist org-protocol-protocol-alist-default))) + (catch 'fname + (let ((the-protocol (concat (regexp-quote org-protocol-the-protocol) ":/+"))) + (when (string-match the-protocol fname) + (dolist (prolist sub-protocols) + (let ((proto (concat the-protocol (regexp-quote (plist-get (cdr prolist) :protocol)) ":/+"))) + (when (string-match proto fname) + (let* ((func (plist-get (cdr prolist) :function)) + (greedy (plist-get (cdr prolist) :greedy)) + (splitted (split-string fname proto)) + (result (if greedy restoffiles (cadr splitted)))) + (when (fboundp func) + (unless greedy + (throw 'fname (funcall func result))) + (funcall func result) + (throw 'fname t)))))))) + ;; (message "fname: %s" fname) + 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)) + (ad-get-arg 0)))) + (catch 'greedy + (dolist (var flist) + (let ((fname (expand-file-name (car var)))) ;; `\' to `/' on windows. FIXME: could this be done any better? + (setq fname (org-protocol-check-filename-for-protocol fname (member var flist))) + (if (eq fname t) ;; greedy? We need the `t' return value. + (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)))))) + )))) + + +;;; Org specific functions: + +(defun org-protocol-create-for-org () + "Create a org-protocol project for the current file's Org-mode project. +This works, if the file visited is part of a publishing project in +`org-publish-project-alist'. This functions calls `org-protocol-create' to do +most of the work." + (interactive) + (org-publish-initialize-files-alist) + (let ((all (or (org-publish-get-project-from-filename buffer-file-name)))) + (if all (org-protocol-create (cdr all)) + (message "Not in an org-project. Did mean %s?" + (substitute-command-keys"\\[org-protocol-create]"))))) + + + +(defun org-protocol-create(&optional project-plist) + "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 worglet. If +project-plist is the CDR of an element in `org-publish-project-alist', reuse +: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 "http://orgmode.org/worg/") + (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")) + + (worglet-buffer nil) + + (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)) + (if (not (string-match "\\/$" base-url)) + (setq base-url (concat base-url "/"))) + + (setq working-dir + (expand-file-name + (read-directory-name "Local working directory: " working-dir working-dir t))) + (if (not (string-match "\\/$" working-dir)) + (setq working-dir (concat working-dir "/"))) + + (setq strip-suffix + (read-string + (concat "Extension to strip from published URLs ("strip-suffix"): ") + strip-suffix nil strip-suffix t)) + + (setq working-suffix + (read-string + (concat "Extension of editable files ("working-suffix"): ") + working-suffix nil working-suffix t)) + + (when (yes-or-no-p "Save the new worglet to your init file? ") + (setq org-protocol-project-alist + (cons `(,base-url . (:base-url ,base-url + :working-directory ,working-dir + :online-suffix ,strip-suffix + :working-suffix ,working-suffix)) + org-protocol-project-alist)) + (customize-save-variable 'org-protocol-project-alist org-protocol-project-alist)) +)) + +(provide 'org-protocol) +;;; org-protocol.el ends here diff --git a/lisp/org.el b/lisp/org.el index 8c2fbedc0..2671dff2c 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -172,6 +172,7 @@ to add the symbol `xyz', and the package must have a call to (const :tag " mac-message: Links to messages in Apple Mail" org-mac-message) (const :tag " mew Links to Mew folders/messages" org-mew) (const :tag " mhe: Links to MHE folders/messages" org-mhe) + (const :tag " protocol: Intercept calls from emacsclient" org-protocol) (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)