arcology-util.el 4.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117
  1. ;;; arcology-util.el --- Interactive utilities for Arcology
  2. ;; Copyright (C) 2016 Ryan Rix
  3. ;; Author: Ryan Rix <ryan@whatthefuck.computer>
  4. ;; Version: 0.1
  5. ;; Package-Requires: ((json "0.1") (org "8.0"))
  6. ;; Keywords: web
  7. ;; URL: http://notes.whatthefuck.computer/
  8. ;;; Commentary:
  9. ;;; Code:
  10. (defun arcology-show-mentions ()
  11. "Show webmention data for my domain."
  12. (interactive)
  13. (let ((req (request (format
  14. "http://webmention.io/api/mentions?perPage=20&domain=notes.whatthefuck.computer&token=%s"
  15. arcology-webmention.io-api-key)
  16. :type "GET"
  17. :parser 'json-read
  18. :sync t)))
  19. (let ((output (mapconcat
  20. (lambda (mention)
  21. (let ((sentence (arcology-alist-get
  22. 'sentence_html
  23. (arcology-alist-get 'activity mention)))
  24. (url (arcology-alist-get
  25. 'url
  26. (arcology-alist-get 'data mention)))
  27. (content (or (arcology-alist-get
  28. 'content
  29. (arcology-alist-get 'data mention))
  30. "No Content")))
  31. (format "<li><a href=\"%s\">URL</a> &rarr; %s &rarr; %s </li>" url content sentence)))
  32. (arcology-alist-get 'links (request-response-data req))
  33. "<br/>")))
  34. (with-temp-buffer
  35. (let ((filename (expand-file-name "~/tmp/arcology-mentions.html")))
  36. (insert (format "<html><head><title>*Arcology Webmentions*</title</head><body><ul>%s</ul></body></html>" output))
  37. (write-file filename)
  38. (eww (format "file://%s" filename)))))))
  39. (defun arcology-like-link (url)
  40. (interactive "MURL? ")
  41. (let ((org-capture-templates '(("A" "Arcology like of"
  42. entry
  43. (file org-default-notes-file)
  44. "* Ryan likes %c :LIKE:EXPORT:
  45. :PROPERTIES:
  46. :U-LIKE-OF: %c
  47. :END:
  48. %U
  49. "))))
  50. (kill-new url)
  51. (org-capture nil "A")))
  52. (defun arcology-reply-to-link (url)
  53. (interactive "MURL? ")
  54. (let ((org-capture-templates '(("A" "Arcology reply to"
  55. entry
  56. (file org-default-notes-file)
  57. "* %? :REPLY:EXPORT:
  58. :PROPERTIES:
  59. :U-IN-REPLY-TO: %c
  60. :END:
  61. %U
  62. "))))
  63. (kill-new url)
  64. (org-capture nil "A")))
  65. (add-to-list 'org-capture-templates `("_" "Published shortnote" entry (file ,(expand-file-name "~/Code/notes/index.org"))
  66. "* %? :EXPORT:\n%U\n%a\n" :prepend t))
  67. (defun arcology-web-mention (source target)
  68. (interactive "MSource: \nMTarget")
  69. (let* ((url-request-data (format "source=%s&target=%s" source target))
  70. (url-request-method "POST")
  71. (webmention-url (arcology-extract-webmention-endpoint target)))
  72. (when webmention-url
  73. (with-current-buffer (url-retrieve-synchronously webmention-url)
  74. (buffer-string)))))
  75. (defun arcology-extract-webmention-endpoint (url)
  76. (let ((url-request-method "GET"))
  77. (with-current-buffer (url-retrieve-synchronously url)
  78. (goto-char url-http-end-of-headers)
  79. (let ((start (search-forward-regexp "<link rel=\"webmention\" href=\""))
  80. (end (search-forward "\"")))
  81. (buffer-substring start (- end 1))))))
  82. (defun arcology-send-web-mentions-for-post (point)
  83. (interactive "d")
  84. (save-excursion
  85. (let* (urls
  86. (properties (org-entry-properties point))
  87. (base-url (plist-get arcology-publish-config :html-link-home))
  88. (next-heading (save-excursion (outline-next-heading) (point)))
  89. (permalink (alist-get "RSS_PERMALINK" properties nil nil 'equal)))
  90. (org-back-to-heading)
  91. (condition-case error
  92. (while (re-search-forward "\\[\\[\\(http.[^\]]+\\)\\]\\[[^\]]+\\]\\]" next-heading)
  93. (add-to-list 'urls (match-string-no-properties 1)))
  94. (error nil))
  95. (let ((in-reply-to (alist-get "U-IN-REPLY-TO" properties nil nil 'equal)))
  96. (when in-reply-to
  97. (add-to-list 'urls in-reply-to)))
  98. (dolist (url urls)
  99. (arcology-web-mention (concat base-url "/" permalink) url)))))
  100. (provide 'arcology-util)
  101. ;;; arcology-util.el ends here