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 new-style complex links
  39   (let* ((url (concat "template=p&"
  40                       "url=https%3A%2F%2Forgmode.org%2Forg.html%23capture-protocol&"
  41                       "title=The%20Org%20Manual&"
  42                       "body=9.4.2%20capture%20protocol"))
  43          (data (org-protocol-parse-parameters url)))
  44     (should (string= (plist-get data :template) "p"))
  45     (should (string= (plist-get data :url) "https://orgmode.org/org.html#capture-protocol"))
  46     (should (string= (plist-get data :title) "The Org Manual"))
  47     (should (string= (plist-get data :body) "9.4.2 capture protocol")))
  48   ;; Parse old-style links
  49   (let ((data (org-protocol-parse-parameters "abc/def" nil '(:url :title))))
  50     (should (string= (plist-get data :url) "abc"))
  51     (should (string= (plist-get data :title) "def")))
  52   ;; Parse old-style links even without keys
  53   (let ((data (org-protocol-parse-parameters "b/abc/def" nil)))
  54     (should (equal data '("b" "abc" "def"))))
  55   ;; Parse old-style links with key/val pairs
  56   (let ((data (org-protocol-parse-parameters "b/abc/extrakey/extraval" nil '(:param1 :param2))))
  57     (should (string= (plist-get data :param1) "b"))
  58     (should (string= (plist-get data :param2) "abc"))
  59     (should (string= (plist-get data :extrakey) "extraval"))))
  60
  61 (ert-deftest test-org-protocol/org-protocol-store-link ()
  62   "Test `org-protocol-store-link' specifications."
  63   ;; Old link style
  64   (let ((uri "/some/directory/org-protocol:/store-link:/URL/TITLE"))
  65     (should (null (org-protocol-check-filename-for-protocol uri (list uri) nil)))
  66     (should (equal (car org-stored-links) '("URL" "TITLE"))))
  67   ;; URL encoded
  68   (let ((uri (format "/some/directory/org-protocol:/store-link:/%s/TITLE"
  69                      (url-hexify-string "http://example.com"))))
  70     (should (null (org-protocol-check-filename-for-protocol uri (list uri) nil)))
  71     (should (equal (car org-stored-links) '("http://example.com" "TITLE"))))
  72   ;; Handle multiple slashes, old link style
  73   (let ((uri "/some/directory/org-protocol://store-link://URL2//TITLE2"))
  74     (should (null (org-protocol-check-filename-for-protocol uri (list uri) nil)))
  75     (should (equal (car org-stored-links) '("URL2" "TITLE2"))))
  76   ;; New link style
  77   (let ((uri "/some/directory/org-protocol://store-link?url=URL3&title=TITLE3"))
  78     (should (null (org-protocol-check-filename-for-protocol uri (list uri) nil)))
  79     (should (equal (car org-stored-links) '("URL3" "TITLE3")))))
  80
  81 (ert-deftest test-org-protocol/org-protocol-capture ()
  82   "Test `org-protocol-capture' specifications."
  83   (let* ((org-protocol-default-template-key "t")
  84          (temp-file-name (make-temp-file "org-protocol-test"))
  85          (org-capture-templates
  86           `(("t" "Test" entry (file ,temp-file-name) "** TODO\n\n%i\n\n%a\n" :kill-buffer t)
  87             ("x" "With params" entry (file ,temp-file-name) "** SOMEDAY\n\n%i\n\n%a\n" :kill-buffer t)
  88             ("X" "Just the template" entry (file ,temp-file-name) "** Hello World\n\n%i\n\nGoodbye World\n" :kill-buffer t)))
  89          (test-urls
  90           '(
  91             ;; Old style:
  92             ;; - multiple slashes
  93             ("/some/directory/org-protocol:/capture:/URL/TITLE"
  94              . "** TODO\n\n\n\n[[URL][TITLE]]\n")
  95             ;; - body specification
  96             ("/some/directory/org-protocol:/capture:/URL/TITLE/BODY"
  97              . "** TODO\n\nBODY\n\n[[URL][TITLE]]\n")
  98             ;; - template
  99             ("/some/directory/org-protocol:/capture:/x/URL/TITLE/BODY"
 100              . "** SOMEDAY\n\nBODY\n\n[[URL][TITLE]]\n")
 101             ;; - query parameters, not sure how to include them in template
 102             ("/some/directory/org-protocol:/capture:/x/URL/TITLE/BODY/from/example"
 103              . "** SOMEDAY\n\nBODY\n\n[[URL][TITLE]]\n")
 104             ;; New style:
 105             ;; - multiple slashes
 106             ("/some/directory/org-protocol:/capture?url=NEWURL&title=TITLE"
 107              . "** TODO\n\n\n\n[[NEWURL][TITLE]]\n")
 108             ;; - body specification
 109             ("/some/directory/org-protocol:/capture?url=NEWURL&title=TITLE&body=BODY"
 110              . "** TODO\n\nBODY\n\n[[NEWURL][TITLE]]\n")
 111             ;; - template
 112             ("/some/directory/org-protocol:/capture?template=x&url=NEWURL&title=TITLE&body=BODY"
 113              . "** SOMEDAY\n\nBODY\n\n[[NEWURL][TITLE]]\n")
 114             ;; - no url specified
 115             ("/some/directory/org-protocol:/capture?template=x&title=TITLE&body=BODY"
 116             . "** SOMEDAY\n\nBODY\n\nTITLE\n")
 117             ;; - no title specified
 118             ("/some/directory/org-protocol:/capture?template=x&url=NEWURL&body=BODY"
 119              . "** SOMEDAY\n\nBODY\n\n[[NEWURL][NEWURL]]\n")
 120             ;; - just the template
 121             ("/some/directory/org-protocol:/capture?template=X"
 122              . "** Hello World\n\n\n\nGoodbye World\n")
 123             ;; - query parameters, not sure how to include them in template
 124             ("/some/directory/org-protocol:/capture?template=x&url=URL&title=TITLE&body=BODY&from=example"
 125              . "** SOMEDAY\n\nBODY\n\n[[URL][TITLE]]\n")
 126             )))
 127     ;; Old link style
 128     (mapc
 129      (lambda (test-case)
 130        (let ((uri (car test-case)))
 131          (org-protocol-check-filename-for-protocol uri (list uri) nil)
 132          (should (string= (buffer-string) (cdr test-case)))
 133          (org-capture-kill)))
 134      test-urls)
 135     (delete-file temp-file-name)))
 136
 137 (ert-deftest test-org-protocol/org-protocol-open-source ()
 138   "Test org-protocol://open-source links."
 139   (let* ((temp-file-name1 (make-temp-file "org-protocol-test1"))
 140          (temp-file-name2 (make-temp-file "org-protocol-test2"))
 141          (org-protocol-project-alist
 142           `((test1
 143              :base-url "http://example.com/"
 144              :online-suffix ".html"
 145              :working-directory ,(file-name-directory temp-file-name1))
 146             (test2
 147              :base-url "http://another.example.com/"
 148              :online-suffix ".js"
 149              :working-directory ,(file-name-directory temp-file-name2))
 150             (test3
 151              :base-url "https://blog-example.com/"
 152              :working-directory ,(file-name-directory temp-file-name2)
 153              :online-suffix ".html"
 154              :working-suffix ".md"
 155              :rewrites (("\\(https://blog-example.com/[0-9]+/[0-9]+/[0-9]+/\\)" . ".md")))))
 156          (test-cases
 157           (list
 158            ;; Old-style URLs
 159            (cons
 160             (concat "/some/directory/org-protocol:/open-source:/"
 161                     (url-hexify-string
 162                      (concat "http://example.com/" (file-name-nondirectory temp-file-name1) ".html")))
 163             temp-file-name1)
 164            (cons
 165             (concat "/some/directory/org-protocol:/open-source:/"
 166                     (url-hexify-string
 167                      (concat "http://another.example.com/" (file-name-nondirectory temp-file-name2) ".js")))
 168             temp-file-name2)
 169            ;; New-style URLs
 170            (cons
 171             (concat "/some/directory/org-protocol:/open-source?url="
 172                     (url-hexify-string
 173                      (concat "http://example.com/" (file-name-nondirectory temp-file-name1) ".html")))
 174             temp-file-name1)
 175            (cons
 176             (concat "/some/directory/org-protocol:/open-source?url="
 177                     (url-hexify-string
 178                      (concat "http://another.example.com/" (file-name-nondirectory temp-file-name2) ".js")))
 179             temp-file-name2))))
 180     (mapc (lambda (test-case)
 181             (should (string=
 182                      (org-protocol-check-filename-for-protocol
 183                       (car test-case)
 184                       (list (car test-case)) nil)
 185                      (cdr test-case))))
 186           test-cases)
 187     (delete-file temp-file-name1)
 188     (delete-file temp-file-name2)))
 189
 190 (defun test-org-protocol/org-protocol-greedy-handler (fname)
 191   ;; fname should be a list of parsed items
 192   (should (listp fname))
 193   nil)
 194
 195 (ert-deftest test-org-protocol/org-protocol-with-greedy-handler ()
 196   "Check that greedy handlers are called with all the filenames."
 197   (let ((org-protocol-protocol-alist
 198          '(("protocol-a" :protocol "greedy" :function test-org-protocol/org-protocol-greedy-handler :kill-client t :greedy t))))
 199     ;; Neither of these should signal errors
 200     (let ((uri "/some/dir/org-protocol://greedy?a=b&c=d")
 201           (uri2 "/some/dir/org-protocol://greedy?e=f&g=h"))
 202       (org-protocol-check-filename-for-protocol uri (list uri uri2) nil))))
 203
 204
 205 ;; TODO: Verify greedy protocol handling
 206 ;;; test-org-protocol.el ends here