org-protocol: Simplifactions

lisp/org-protocol.el

@@ -147,7 +147,7 @@ for `org-protocol-the-protocol' and sub-procols defined in
 ;;; Variables:
 
 (defconst org-protocol-protocol-alist-default
-  '(("org-remember"    :protocol "remember"    :function org-protocol-remember)
+  '(("org-remember"    :protocol "remember"    :function org-protocol-remember :kill-client t)
     ("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.
@@ -216,7 +216,7 @@ Consider using the interactive functions `org-protocol-create' and
 
 Each element of this list must be of the form:
 
-  (module-name :protocol protocol :function func)
+  (module-name :protocol protocol :function func :kill-client nil)
 
 protocol - protocol to detect in a filename without trailing colon and slashes.
            See rfc1738 section 2.1 for more on this.
@@ -235,6 +235,12 @@ function - function that handles requests with protocol and takes exactly one
            if you stay with the conventions used for the standard handlers in
            `org-protocol-protocol-alist-default'. See `org-protocol-split-data'.
 
+kill-client - If t, kill the client immediately, once the sub-protocol is
+           detected. This is neccessary for actions that can be interupted by
+           `C-g' to avoid dangeling emacsclients. Note, that all other command
+           line arguments but the this one will be discarded, greedy handlers
+           still receive the whole list of arguments though.
+
 Here is an example:
 
   (setq org-protocol-protocol-alist
@@ -326,31 +332,26 @@ URL with a character and a slash like so:
 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))
+           (fboundp 'org-remember))
+      (let* ((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 (org-make-link-string url title))
+             remember-annotation-functions)
+        (setq org-stored-links
+              (cons (list url title) org-stored-links))
+        (kill-new orglink)
+        (org-store-link-props :type type
+                              :link url
+                              :description title
+                              :initial region)
+        (raise-frame)
+        (org-remember nil (string-to-char template)))
+    
     (message "Org-mode not loaded."))
   nil)
 
@@ -393,7 +394,7 @@ The location for a browser's bookmark should look like this:
 
 ;;; Core functions:
 
-(defun org-protocol-check-filename-for-protocol (fname restoffiles)
+(defun org-protocol-check-filename-for-protocol (fname restoffiles client)
   "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'.
@@ -420,6 +421,8 @@ as filename."
                        (greedy (plist-get (cdr prolist) :greedy))
                        (splitted (split-string fname proto))
                        (result (if greedy restoffiles (cadr splitted))))
+                  (if (plist-get (cdr prolist) :kill-client)
+                      (server-delete-client client t))
                   (when (fboundp func)
                     (unless greedy
                       (throw 'fname (funcall func result)))
@@ -433,11 +436,12 @@ as filename."
   "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))))
+                 (ad-get-arg 0)))
+        (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)))
+          (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)
@@ -447,7 +451,6 @@ as filename."
               (ad-set-arg 0 (delq var (ad-get-arg 0))))))
         ))))
 
-
 ;;; Org specific functions:
 
 (defun org-protocol-create-for-org ()