Merge changes from Org 7.4 to current Org 7.7.

1 files changed, 55 insertions, 112 deletions

diff --git a/lisp/org/org-protocol.el b/lisp/org/org-protocol.el
index 018eadf9a23..42a71224aea 100644
--- a/lisp/org/org-protocol.el
+++ b/lisp/org/org-protocol.el
@@ -1,6 +1,7 @@
 ;;; org-protocol.el --- Intercept calls from emacsclient to trigger custom actions.
 ;;
-;; Copyright (C) 2008-2011  Free Software Foundation, Inc.
+;; Copyright (C) 2008, 2009, 2010
+;;          Free Software Foundation, Inc.
 ;;
 ;; Author: Bastien Guerry <bzg AT altern DOT org>
 ;; Author: Daniel M German <dmg AT uvic DOT org>
@@ -8,7 +9,7 @@
 ;; Author: Ross Patterson <me AT rpatterson DOT net>
 ;; Maintainer: Sebastian Rose <sebastian_rose AT gmx DOT de>
 ;; Keywords: org, emacsclient, wp
-;; Version: 7.4
+;; Version: 7.7
 
 ;; This file is part of GNU Emacs.
 ;;
@@ -129,6 +130,18 @@
 		  (filename &optional up))
 (declare-function server-edit "server" (&optional arg))
 
+(define-obsolete-function-alias
+  'org-protocol-unhex-compound 'org-link-unescape-compound
+  "2011-02-17")
+
+(define-obsolete-function-alias
+  'org-protocol-unhex-string 'org-link-unescape
+  "2011-02-17")
+
+(define-obsolete-function-alias
+  'org-protocol-unhex-single-byte-sequence
+  'org-link-unescape-single-byte-sequence
+  "2011-02-17")
 
 (defgroup org-protocol nil
   "Intercept calls from emacsclient to trigger custom actions.
@@ -151,7 +164,6 @@ for `org-protocol-the-protocol' and sub-procols defined in
   "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
@@ -159,11 +171,10 @@ 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
-  "* Non-nil means re-reverse the list of filenames passed on the command line.
+  "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
@@ -171,9 +182,8 @@ unchanged."
   :group 'org-protocol
   :type 'boolean)
 
-
 (defcustom org-protocol-project-alist nil
-  "* Map URLs to local filenames for `org-protocol-open-source' (open-source).
+  "Map URLs to local filenames for `org-protocol-open-source' (open-source).
 
 Each element of this list must be of the form:
 
@@ -216,7 +226,6 @@ Consider using the interactive functions `org-protocol-create' and
   :group 'org-protocol
   :type 'alist)
 
-
 (defcustom org-protocol-protocol-alist nil
   "* Register custom handlers for org-protocol.
 
@@ -260,7 +269,9 @@ Here is an example:
   :type '(alist))
 
 (defcustom org-protocol-default-template-key nil
-  "The default org-remember-templates key to use."
+  "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 'string)
 
@@ -274,95 +285,27 @@ Slashes are sanitized to double slashes here."
       (setq uri (concat (car splitparts) "//" (mapconcat 'identity (cdr splitparts) "/")))))
   uri)
 
-
-(defun org-protocol-split-data(data &optional unhexify separator)
-  "Split, what an org-protocol handler function gets as only argument.
-DATA is that one argument. DATA is split at each occurrence of
-SEPARATOR (regexp). If no SEPARATOR is specified or SEPARATOR is
+(defun org-protocol-split-data (data &optional unhexify separator)
+  "Split what an org-protocol handler function gets as only argument.
+DATA is that one argument.  DATA 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. If UNHEXIFY is non-nil, hex-decode each split part. If
-UNHEXIFY is a function, use that function to decode each split
+as a list.  If UNHEXIFY is non-nil, hex-decode each split part.
+If UNHEXIFY is a function, use that function to decode each split
 part."
   (let* ((sep (or separator "/+"))
          (split-parts (split-string data sep)))
     (if unhexify
 	(if (fboundp unhexify)
 	    (mapcar unhexify split-parts)
-	  (mapcar 'org-protocol-unhex-string split-parts))
+	  (mapcar 'org-link-unescape split-parts))
       split-parts)))
 
-;; This inline function is needed in org-protocol-unhex-compound to do
-;; the right thing to decode UTF-8 char integer values.
-(eval-when-compile
-  (if (>= emacs-major-version 23)
-      (defsubst org-protocol-char-to-string(c)
-	"Defsubst to decode UTF-8 character values in emacs 23 and beyond."
-	(char-to-string c))
-    (defsubst org-protocol-char-to-string (c)
-      "Defsubst to decode UTF-8 character values in emacs 22."
-      (string (decode-char 'ucs c)))))
-
-(defun org-protocol-unhex-string(str)
-  "Unhex hexified unicode strings as returned from the JavaScript function
-encodeURIComponent. E.g. `%C3%B6' is the german Umlaut `ü'."
-  (setq str (or str ""))
-  (let ((tmp "")
-	(case-fold-search t))
-    (while (string-match "\\(%[0-9a-f][0-9a-f]\\)+" str)
-      (let* ((start (match-beginning 0))
-	     (end (match-end 0))
-	     (hex (match-string 0 str))
-	     (replacement (org-protocol-unhex-compound (upcase hex))))
-	(setq tmp (concat tmp (substring str 0 start) replacement))
-	(setq str (substring str end))))
-    (setq tmp (concat tmp str))
-    tmp))
-
-
-(defun org-protocol-unhex-compound (hex)
-  "Unhexify unicode hex-chars. E.g. `%C3%B6' is the German Umlaut `ü'."
-  (let* ((bytes (remove "" (split-string hex "%")))
-	 (ret "")
-	 (eat 0)
-	 (sum 0))
-    (while bytes
-      (let* ((b (pop bytes))
-	     (a (elt b 0))
-	     (b (elt b 1))
-	     (c1 (if (> a ?9) (+ 10 (- a ?A)) (- a ?0)))
-	     (c2 (if (> b ?9) (+ 10 (- b ?A)) (- b ?0)))
-	     (val (+ (lsh c1 4) c2))
-	     (shift
-	      (if (= 0 eat) ;; new byte
-		  (if (>= val 252) 6
-		    (if (>= val 248) 5
-		      (if (>= val 240) 4
-			(if (>= val 224) 3
-			  (if (>= val 192) 2 0)))))
-		6))
-	     (xor
-	      (if (= 0 eat) ;; new byte
-		  (if (>= val 252) 252
-		    (if (>= val 248) 248
-		      (if (>= val 240) 240
-			(if (>= val 224) 224
-			  (if (>= val 192) 192 0)))))
-		128)))
-	(if (>= val 192) (setq eat shift))
-	(setq val (logxor val xor))
-	(setq sum (+ (lsh sum shift) val))
-	(if (> eat 0) (setq eat (- eat 1)))
-	(when (= 0 eat)
-	  (setq ret (concat ret (org-protocol-char-to-string sum)))
-	  (setq sum 0))
-	)) ;; end (while bytes
-    ret ))
-
 (defun org-protocol-flatten-greedy (param-list &optional strip-path replacement)
   "Greedy handlers might receive a list like this from emacsclient:
- '( (\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\")
+ '((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\")
 where \"/dir/\" is the absolute path to emacsclients working directory.  This
-function transforms it into a flat list utilizing `org-protocol-flatten' and
+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
@@ -402,7 +345,6 @@ returned list."
        ret)
     l)))
 
-
 (defun org-protocol-flatten (l)
   "Greedy handlers might receive a list like this from emacsclient:
  '( (\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\")
@@ -413,6 +355,7 @@ This function transforms it into a flat list."
        (append (org-protocol-flatten (car l)) (org-protocol-flatten (cdr l)))
       (list l))))
 
+
 ;;; Standard protocol handlers:
 
 (defun org-protocol-store-link (fname)
@@ -444,7 +387,7 @@ The sub-protocol used to reach this function is set in
              uri))
   nil)
 
-(defun org-protocol-remember  (info)
+(defun org-protocol-remember (info)
   "Process an org-protocol://remember:// style url.
 
 The location for a browser's bookmark has to look like this:
@@ -457,12 +400,12 @@ The location for a browser's bookmark has to look like this:
 See the docs for `org-protocol-capture' for more information."
 
   (if (and (boundp 'org-stored-links)
-           (or (fboundp 'org-capture))
+           (fboundp 'org-capture)
 	   (org-protocol-do-capture info 'org-remember))
-      (message "Org-mode not loaded."))
+      (message "Item remembered."))
   nil)
 
-(defun org-protocol-capture  (info)
+(defun org-protocol-capture (info)
   "Process an org-protocol://capture:// style url.
 
 The sub-protocol used to reach this function is set in
@@ -484,21 +427,21 @@ But you may prepend the encoded URL with a character and a slash like so:
 
 Now template ?b will be used."
   (if (and (boundp 'org-stored-links)
-           (or (fboundp 'org-capture))
+           (fboundp 'org-capture)
 	   (org-protocol-do-capture info 'org-capture))
-      (message "Org-mode not loaded."))
+      (message "Item captured."))
   nil)
 
 (defun org-protocol-do-capture (info capture-func)
   "Support `org-capture' and `org-remember' alike.
 CAPTURE-FUNC is either the symbol `org-remember' or `org-capture'."
   (let* ((parts (org-protocol-split-data info t))
-	 (template (or (and (= 1 (length (car parts))) (pop parts))
+	 (template (or (and (>= 2 (length (car parts))) (pop parts))
 		       org-protocol-default-template-key))
 	 (url (org-protocol-sanitize-uri (car parts)))
 	 (type (if (string-match "^\\([a-z]+\\):" url)
 		   (match-string 1 url)))
-	 (title(or (cadr parts) ""))
+	 (title (or (cadr parts) ""))
 	 (region (or (caddr parts) ""))
 	 (orglink (org-make-link-string
 		   url (if (string-match "[^[:space:]]" title) title url)))
@@ -515,7 +458,6 @@ CAPTURE-FUNC is either the symbol `org-remember' or `org-capture'."
     (raise-frame)
     (funcall capture-func nil template)))
 
-
 (defun org-protocol-open-source (fname)
   "Process an org-protocol://open-source:// style url.
 
@@ -526,11 +468,10 @@ 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 (org-protocol-unhex-string fname)))
+        (f (org-link-unescape fname)))
     (catch 'result
       (dolist (prolist org-protocol-project-alist)
         (let* ((base-url (plist-get (cdr prolist) :base-url))
@@ -595,12 +536,14 @@ 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)))
+  (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)) ":/+")))
+            (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))
@@ -617,7 +560,6 @@ as filename."
       ;; (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
@@ -626,16 +568,17 @@ as filename."
         (client (ad-get-arg 1)))
     (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)  client))
+	;; `\' 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.
               (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))))))
-        ))))
+              (ad-set-arg 0 (delq var (ad-get-arg 0))))))))))
 
 ;;; Org specific functions:
 
@@ -651,8 +594,7 @@ most of the work."
       (message "Not in an org-project. Did mean %s?"
                (substitute-command-keys"\\[org-protocol-create]")))))
 
-
-(defun org-protocol-create(&optional project-plist)
+(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'.
@@ -660,15 +602,15 @@ 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
 :base-directory, :html-extension and :base-extension."
   (interactive)
-  (let ((working-dir (expand-file-name(or (plist-get project-plist :base-directory) default-directory)))
+  (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))
 
@@ -684,12 +626,12 @@ project-plist is the CDR of an element in `org-publish-project-alist', reuse
 
     (setq strip-suffix
           (read-string
-           (concat "Extension to strip from published URLs ("strip-suffix"): ")
+           (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"): ")
+           (concat "Extension of editable files (" working-suffix "): ")
                    working-suffix nil working-suffix t))
 
     (when (yes-or-no-p "Save the new org-protocol-project to your init file? ")
@@ -703,4 +645,5 @@ project-plist is the CDR of an element in `org-publish-project-alist', reuse
 
 (provide 'org-protocol)
 
+;; arch-tag: b5c5c2ac-77cf-4a94-a649-2163dff95846
 ;;; org-protocol.el ends here