org-eww.el 6.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176
  1. ;;; org-eww.el --- Store url and kill from Eww mode for Org -*- lexical-binding: t -*-
  2. ;; Copyright (C) 2014-2018 Free Software Foundation, Inc.
  3. ;; Author: Marco Wahl <marcowahlsoft>a<gmailcom>
  4. ;; Keywords: link, eww
  5. ;; Homepage: https://orgmode.org
  6. ;; This file is part of GNU Emacs.
  7. ;; GNU Emacs is free software: you can redistribute it and/or modify
  8. ;; it under the terms of the GNU General Public License as published by
  9. ;; the Free Software Foundation, either version 3 of the License, or
  10. ;; (at your option) any later version.
  11. ;; GNU Emacs is distributed in the hope that it will be useful,
  12. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. ;; GNU General Public License for more details.
  15. ;; You should have received a copy of the GNU General Public License
  16. ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
  17. ;;; Commentary:
  18. ;; When this module is active `org-store-link' (often on key C-c l) in
  19. ;; an EWW buffer stores a link to the current url of the eww buffer.
  20. ;; In an EWW buffer function `org-eww-copy-for-org-mode' kills either
  21. ;; a region or the whole buffer if no region is set and transforms the
  22. ;; text on the fly so that it can be pasted into an Org buffer with
  23. ;; hot links.
  24. ;; C-c C-x C-w (and also C-c C-x M-w) trigger
  25. ;; `org-eww-copy-for-org-mode'.
  26. ;; Hint: A lot of code of this module comes from module org-w3m which
  27. ;; has been written by Andy Steward based on the idea of Richard
  28. ;; Riley. Thanks!
  29. ;; Potential: Since the code for w3m and eww is so similar one could
  30. ;; try to refactor.
  31. ;;; Code:
  32. (require 'org)
  33. (require 'cl-lib)
  34. (defvar eww-current-title)
  35. (defvar eww-current-url)
  36. (defvar eww-data)
  37. (defvar eww-mode-map)
  38. (declare-function eww-current-url "eww")
  39. ;; Store Org-link in eww-mode buffer
  40. (org-link-set-parameters "eww" :follow #'eww :store #'org-eww-store-link)
  41. (defun org-eww-store-link ()
  42. "Store a link to the url of an EWW buffer."
  43. (when (eq major-mode 'eww-mode)
  44. (org-store-link-props
  45. :type "eww"
  46. :link (if (< emacs-major-version 25)
  47. eww-current-url
  48. (eww-current-url))
  49. :url (url-view-url t)
  50. :description (if (< emacs-major-version 25)
  51. (or eww-current-title eww-current-url)
  52. (or (plist-get eww-data :title)
  53. (eww-current-url))))))
  54. ;; Some auxiliary functions concerning links in eww buffers
  55. (defun org-eww-goto-next-url-property-change ()
  56. "Move to the start of next link if exists.
  57. Otherwise point is not moved. Return point."
  58. (goto-char
  59. (or (next-single-property-change (point) 'shr-url)
  60. (point))))
  61. (defun org-eww-has-further-url-property-change-p ()
  62. "Non-nil if there is a next url property change."
  63. (save-excursion
  64. (not (eq (point) (org-eww-goto-next-url-property-change)))))
  65. (defun org-eww-url-below-point ()
  66. "Return the url below point if there is an url; otherwise, return nil."
  67. (get-text-property (point) 'shr-url))
  68. (defun org-eww-copy-for-org-mode ()
  69. "Copy current buffer content or active region with `org-mode' style links.
  70. This will encode `link-title' and `link-location' with
  71. `org-make-link-string', and insert the transformed test into the kill ring,
  72. so that it can be yanked into an Org mode buffer with links working correctly.
  73. Further lines starting with a star get quoted with a comma to keep
  74. the structure of the Org file."
  75. (interactive)
  76. (let* ((regionp (org-region-active-p))
  77. (transform-start (point-min))
  78. (transform-end (point-max))
  79. return-content
  80. link-location link-title
  81. temp-position out-bound)
  82. (when regionp
  83. (setq transform-start (region-beginning))
  84. (setq transform-end (region-end))
  85. ;; Deactivate mark if current mark is activate.
  86. (when (fboundp 'deactivate-mark) (deactivate-mark)))
  87. (message "Transforming links...")
  88. (save-excursion
  89. (goto-char transform-start)
  90. (while (and (not out-bound) ; still inside region to copy
  91. (org-eww-has-further-url-property-change-p)) ; there is a next link
  92. ;; Store current point before jump next anchor.
  93. (setq temp-position (point))
  94. ;; Move to next anchor when current point is not at anchor.
  95. (or (org-eww-url-below-point)
  96. (org-eww-goto-next-url-property-change))
  97. (cl-assert
  98. (org-eww-url-below-point) t
  99. "program logic error: point must have an url below but it hasn't")
  100. (if (<= (point) transform-end) ; if point is inside transform bound
  101. (progn
  102. ;; Get content between two links.
  103. (when (< temp-position (point))
  104. (setq return-content (concat return-content
  105. (buffer-substring
  106. temp-position (point)))))
  107. ;; Get link location at current point.
  108. (setq link-location (org-eww-url-below-point))
  109. ;; Get link title at current point.
  110. (setq link-title
  111. (buffer-substring
  112. (point)
  113. (org-eww-goto-next-url-property-change)))
  114. ;; concat `org-mode' style url to `return-content'.
  115. (setq return-content
  116. (concat return-content
  117. (if (stringp link-location)
  118. ;; hint: link-location is different for form-elements.
  119. (org-make-link-string link-location link-title)
  120. link-title))))
  121. (goto-char temp-position) ; reset point before jump next anchor
  122. (setq out-bound t) ; for break out `while' loop
  123. ))
  124. ;; Add the rest until end of the region to be copied.
  125. (when (< (point) transform-end)
  126. (setq return-content
  127. (concat return-content
  128. (buffer-substring (point) transform-end))))
  129. ;; Quote lines starting with *.
  130. (org-kill-new (replace-regexp-in-string "^\\*" ",*" return-content))
  131. (message "Transforming links...done, use C-y to insert text into Org mode file"))))
  132. ;; Additional keys for eww-mode
  133. (defun org-eww-extend-eww-keymap ()
  134. (define-key eww-mode-map "\C-c\C-x\M-w" 'org-eww-copy-for-org-mode)
  135. (define-key eww-mode-map "\C-c\C-x\C-w" 'org-eww-copy-for-org-mode))
  136. (when (and (boundp 'eww-mode-map)
  137. (keymapp eww-mode-map)) ; eww is already up.
  138. (org-eww-extend-eww-keymap))
  139. (add-hook 'eww-mode-hook #'org-eww-extend-eww-keymap)
  140. (provide 'org-eww)
  141. ;;; org-eww.el ends here