testing/lisp/test-org-protocol.el

   1 ;;; test-org-protocol.el --- tests for org-protocol.el                  -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (c)  Sacha Chua
   4 ;; Authors: Sacha Chua
   5
   6 ;; This file is not part of GNU Emacs.
   7
   8 ;; This program is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation, either version 3 of the License, or
  11 ;; (at your option) any later version.
  12
  13 ;; This program is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 ;;; Code:
  22
  23 (require 'cl-lib)
  24
  25 (unless (featurep 'org-protocol)
  26   (signal 'missing-test-dependency "Support for org-protocol"))
  27
  28 (ert-deftest test-org-protocol/org-protocol-parse-parameters ()
  29   "Test `org-protocol-parse-parameters' specifications."
  30   ;; Ignore lists
  31   (let ((data (org-protocol-parse-parameters '(:url "abc" :title "def") nil)))
  32     (should (string= (plist-get data :url) "abc"))
  33     (should (string= (plist-get data :title) "def")))
  34   ;; Parse new-style links
  35   (let ((data (org-protocol-parse-parameters "url=abc&title=def" t)))
  36     (should (string= (plist-get data :url) "abc"))
  37     (should (string= (plist-get data :title) "def")))
  38   ;; Parse old-style links
  39   (let ((data (org-protocol-parse-parameters "abc/def" nil '(:url :title))))
  40     (should (string= (plist-get data :url) "abc"))
  41     (should (string= (plist-get data :title) "def")))
  42   ;; Parse old-style links even without keys
  43   (let ((data (org-protocol-parse-parameters "b/abc/def" nil)))
  44     (should (equal data '("b" "abc" "def"))))
  45   ;; Parse old-style links with key/val pairs
  46   (let ((data (org-protocol-parse-parameters "b/abc/extrakey/extraval" nil '(:param1 :param2))))
  47     (should (string= (plist-get data :param1) "b"))
  48     (should (string= (plist-get data :param2) "abc"))
  49     (should (string= (plist-get data :extrakey) "extraval"))))
  50
  51 (ert-deftest test-org-protocol/org-protocol-store-link ()
  52   "Test `org-protocol-store-link' specifications."
  53   ;; Old link style
  54   (let ((uri "/some/directory/org-protocol:/store-link:/URL/TITLE"))
  55     (should (null (org-protocol-check-filename-for-protocol uri (list uri) nil)))
  56     (should (equal (car org-stored-links) '("URL" "TITLE"))))
  57   ;; URL encoded
  58   (let ((uri (format "/some/directory/org-protocol:/store-link:/%s/TITLE"
  59                      (url-hexify-string "http://example.com"))))
  60     (should (null (org-protocol-check-filename-for-protocol uri (list uri) nil)))
  61     (should (equal (car org-stored-links) '("http://example.com" "TITLE"))))
  62   ;; Handle multiple slashes, old link style
  63   (let ((uri "/some/directory/org-protocol://store-link://URL2//TITLE2"))
  64     (should (null (org-protocol-check-filename-for-protocol uri (list uri) nil)))
  65     (should (equal (car org-stored-links) '("URL2" "TITLE2"))))
  66   ;; New link style
  67   (let ((uri "/some/directory/org-protocol://store-link?url=URL3&title=TITLE3"))
  68     (should (null (org-protocol-check-filename-for-protocol uri (list uri) nil)))
  69     (should (equal (car org-stored-links) '("URL3" "TITLE3")))))
  70
  71 (ert-deftest test-org-protocol/org-protocol-capture ()
  72   "Test `org-protocol-capture' specifications."
  73   (let* ((org-protocol-default-template-key "t")
  74          (temp-file-name (make-temp-file "org-protocol-test"))
  75          (org-capture-templates
  76           `(("t" "Test" entry (file ,temp-file-name) "** TODO\n\n%i\n\n%a\n" :kill-buffer t)
  77             ("x" "With params" entry (file ,temp-file-name) "** SOMEDAY\n\n%i\n\n%a\n" :kill-buffer t)
  78             ("X" "Just the template" entry (file ,temp-file-name) "** Hello World\n\n%i\n\nGoodbye World\n" :kill-buffer t)))
  79          (test-urls
  80           '(
  81             ;; Old style:
  82             ;; - multiple slashes
  83             ("/some/directory/org-protocol:/capture:/URL/TITLE"
  84              . "** TODO\n\n\n\n[[URL][TITLE]]\n")
  85             ;; - body specification
  86             ("/some/directory/org-protocol:/capture:/URL/TITLE/BODY"
  87              . "** TODO\n\nBODY\n\n[[URL][TITLE]]\n")
  88             ;; - template
  89             ("/some/directory/org-protocol:/capture:/x/URL/TITLE/BODY"
  90              . "** SOMEDAY\n\nBODY\n\n[[URL][TITLE]]\n")
  91             ;; - query parameters, not sure how to include them in template
  92             ("/some/directory/org-protocol:/capture:/x/URL/TITLE/BODY/from/example"
  93              . "** SOMEDAY\n\nBODY\n\n[[URL][TITLE]]\n")
  94             ;; New style:
  95             ;; - multiple slashes
  96             ("/some/directory/org-protocol:/capture?url=NEWURL&title=TITLE"
  97              . "** TODO\n\n\n\n[[NEWURL][TITLE]]\n")
  98             ;; - body specification
  99             ("/some/directory/org-protocol:/capture?url=NEWURL&title=TITLE&body=BODY"
 100              . "** TODO\n\nBODY\n\n[[NEWURL][TITLE]]\n")
 101             ;; - template
 102             ("/some/directory/org-protocol:/capture?template=x&url=NEWURL&title=TITLE&body=BODY"
 103              . "** SOMEDAY\n\nBODY\n\n[[NEWURL][TITLE]]\n")
 104             ;; - no url specified
 105             ("/some/directory/org-protocol:/capture?template=x&title=TITLE&body=BODY"
 106             . "** SOMEDAY\n\nBODY\n\nTITLE\n")
 107             ;; - no title specified
 108             ("/some/directory/org-protocol:/capture?template=x&url=NEWURL&body=BODY"
 109              . "** SOMEDAY\n\nBODY\n\n[[NEWURL][NEWURL]]\n")
 110             ;; - just the template
 111             ("/some/directory/org-protocol:/capture?template=X"
 112              . "** Hello World\n\n\n\nGoodbye World\n")
 113             ;; - query parameters, not sure how to include them in template
 114             ("/some/directory/org-protocol:/capture?template=x&url=URL&title=TITLE&body=BODY&from=example"
 115              . "** SOMEDAY\n\nBODY\n\n[[URL][TITLE]]\n")
 116             )))
 117     ;; Old link style
 118     (mapc
 119      (lambda (test-case)
 120        (let ((uri (car test-case)))
 121          (org-protocol-check-filename-for-protocol uri (list uri) nil)
 122          (should (string= (buffer-string) (cdr test-case)))
 123          (org-capture-kill)))
 124      test-urls)
 125     (delete-file temp-file-name)))
 126
 127 (ert-deftest test-org-protocol/org-protocol-open-source ()
 128   "Test org-protocol://open-source links."
 129   (let* ((temp-file-name1 (make-temp-file "org-protocol-test1"))
 130          (temp-file-name2 (make-temp-file "org-protocol-test2"))
 131          (org-protocol-project-alist
 132           `((test1
 133              :base-url "http://example.com/"
 134              :online-suffix ".html"
 135              :working-directory ,(file-name-directory temp-file-name1))
 136             (test2
 137              :base-url "http://another.example.com/"
 138              :online-suffix ".js"
 139              :working-directory ,(file-name-directory temp-file-name2))
 140             (test3
 141              :base-url "https://blog-example.com/"
 142              :working-directory ,(file-name-directory temp-file-name2)
 143              :online-suffix ".html"
 144              :working-suffix ".md"
 145              :rewrites (("\\(https://blog-example.com/[0-9]+/[0-9]+/[0-9]+/\\)" . ".md")))))
 146          (test-cases
 147           (list
 148            ;; Old-style URLs
 149            (cons
 150             (concat "/some/directory/org-protocol:/open-source:/"
 151                     (url-hexify-string
 152                      (concat "http://example.com/" (file-name-nondirectory temp-file-name1) ".html")))
 153             temp-file-name1)
 154            (cons
 155             (concat "/some/directory/org-protocol:/open-source:/"
 156                     (url-hexify-string
 157                      (concat "http://another.example.com/" (file-name-nondirectory temp-file-name2) ".js")))
 158             temp-file-name2)
 159            ;; New-style URLs
 160            (cons
 161             (concat "/some/directory/org-protocol:/open-source?url="
 162                     (url-hexify-string
 163                      (concat "http://example.com/" (file-name-nondirectory temp-file-name1) ".html")))
 164             temp-file-name1)
 165            (cons
 166             (concat "/some/directory/org-protocol:/open-source?url="
 167                     (url-hexify-string
 168                      (concat "http://another.example.com/" (file-name-nondirectory temp-file-name2) ".js")))
 169             temp-file-name2))))
 170     (mapc (lambda (test-case)
 171             (should (string=
 172                      (org-protocol-check-filename-for-protocol
 173                       (car test-case)
 174                       (list (car test-case)) nil)
 175                      (cdr test-case))))
 176           test-cases)
 177     (delete-file temp-file-name1)
 178     (delete-file temp-file-name2)))
 179
 180 (defun test-org-protocol/org-protocol-greedy-handler (fname)
 181   ;; fname should be a list of parsed items
 182   (should (listp fname))
 183   nil)
 184
 185 (ert-deftest test-org-protocol/org-protocol-with-greedy-handler ()
 186   "Check that greedy handlers are called with all the filenames."
 187   (let ((org-protocol-protocol-alist
 188          '(("protocol-a" :protocol "greedy" :function test-org-protocol/org-protocol-greedy-handler :kill-client t :greedy t))))
 189     ;; Neither of these should signal errors
 190     (let ((uri "/some/dir/org-protocol://greedy?a=b&c=d")
 191           (uri2 "/some/dir/org-protocol://greedy?e=f&g=h"))
 192       (org-protocol-check-filename-for-protocol uri (list uri uri2) nil))))
 193
 194
 195 ;; TODO: Verify greedy protocol handling
 196 ;;; test-org-protocol.el ends here