org-w3m.el 7.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185
  1. ;;; org-w3m.el --- Support from Copy and Paste From w3m -*- lexical-binding: t; -*-
  2. ;; Copyright (C) 2008-2018 Free Software Foundation, Inc.
  3. ;; Author: Andy Stewart <lazycat dot manatee at gmail dot com>
  4. ;; Keywords: outlines, hypermedia, calendar, wp
  5. ;; Homepage: https://orgmode.org
  6. ;;
  7. ;; This file is part of GNU Emacs.
  8. ;;
  9. ;; This program is free software: you can redistribute it and/or modify
  10. ;; it under the terms of the GNU General Public License as published by
  11. ;; the Free Software Foundation, either version 3 of the License, or
  12. ;; (at your option) any later version.
  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. ;; You should have received a copy of the GNU General Public License
  18. ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
  19. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  20. ;;
  21. ;;; Commentary:
  22. ;; This file implements copying HTML content from a w3m buffer and
  23. ;; transforming the text on the fly so that it can be pasted into an
  24. ;; Org buffer with hot links. It will also work for regions in gnus
  25. ;; buffers that have been washed with w3m.
  26. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  27. ;;
  28. ;;; Acknowledgments:
  29. ;; Richard Riley <rileyrgdev at googlemail dot com>
  30. ;;
  31. ;; The idea of transforming the HTML content with Org syntax is
  32. ;; proposed by Richard, I'm just coding it.
  33. ;;
  34. ;;; Code:
  35. (require 'org)
  36. (defvar w3m-current-url)
  37. (defvar w3m-current-title)
  38. (org-link-set-parameters "w3m" :store #'org-w3m-store-link)
  39. (defun org-w3m-store-link ()
  40. "Store a link to a w3m buffer."
  41. (when (eq major-mode 'w3m-mode)
  42. (org-store-link-props
  43. :type "w3m"
  44. :link w3m-current-url
  45. :url (url-view-url t)
  46. :description (or w3m-current-title w3m-current-url))))
  47. (defun org-w3m-copy-for-org-mode ()
  48. "Copy current buffer content or active region with Org style links.
  49. This will encode `link-title' and `link-location' with
  50. `org-make-link-string', and insert the transformed test into the kill ring,
  51. so that it can be yanked into an Org buffer with links working correctly."
  52. (interactive)
  53. (let* ((regionp (org-region-active-p))
  54. (transform-start (point-min))
  55. (transform-end (point-max))
  56. return-content
  57. link-location link-title
  58. temp-position out-bound)
  59. (when regionp
  60. (setq transform-start (region-beginning))
  61. (setq transform-end (region-end))
  62. ;; Deactivate mark if current mark is activate.
  63. (when (fboundp 'deactivate-mark) (deactivate-mark)))
  64. (message "Transforming links...")
  65. (save-excursion
  66. (goto-char transform-start)
  67. (while (and (not out-bound) ; still inside region to copy
  68. (not (org-w3m-no-next-link-p))) ; no next link current buffer
  69. ;; store current point before jump next anchor
  70. (setq temp-position (point))
  71. ;; move to next anchor when current point is not at anchor
  72. (or (get-text-property (point) 'w3m-href-anchor) (org-w3m-get-next-link-start))
  73. (if (<= (point) transform-end) ; if point is inside transform bound
  74. (progn
  75. ;; get content between two links.
  76. (when (> (point) temp-position)
  77. (setq return-content (concat return-content
  78. (buffer-substring
  79. temp-position (point)))))
  80. ;; get link location at current point.
  81. (setq link-location (get-text-property (point) 'w3m-href-anchor))
  82. ;; get link title at current point.
  83. (setq link-title (buffer-substring (point)
  84. (org-w3m-get-anchor-end)))
  85. ;; concat Org style url to `return-content'.
  86. (setq return-content
  87. (concat return-content
  88. (if (org-string-nw-p link-location)
  89. (org-make-link-string link-location link-title)
  90. link-title))))
  91. (goto-char temp-position) ; reset point before jump next anchor
  92. (setq out-bound t))) ; for break out `while' loop
  93. ;; add the rest until end of the region to be copied
  94. (when (< (point) transform-end)
  95. (setq return-content
  96. (concat return-content
  97. (buffer-substring (point) transform-end))))
  98. (org-kill-new return-content)
  99. (message "Transforming links...done, use C-y to insert text into Org file")
  100. (message "Copy with link transformation complete."))))
  101. (defun org-w3m-get-anchor-start ()
  102. "Move cursor to the start of current anchor. Return point."
  103. ;; get start position of anchor or current point
  104. (goto-char (or (previous-single-property-change (point) 'w3m-anchor-sequence)
  105. (point))))
  106. (defun org-w3m-get-anchor-end ()
  107. "Move cursor to the end of current anchor. Return point."
  108. ;; get end position of anchor or point
  109. (goto-char (or (next-single-property-change (point) 'w3m-anchor-sequence)
  110. (point))))
  111. (defun org-w3m-get-next-link-start ()
  112. "Move cursor to the start of next link. Return point."
  113. (catch 'reach
  114. (while (next-single-property-change (point) 'w3m-anchor-sequence)
  115. ;; jump to next anchor
  116. (goto-char (next-single-property-change (point) 'w3m-anchor-sequence))
  117. (when (get-text-property (point) 'w3m-href-anchor)
  118. ;; return point when current is valid link
  119. (throw 'reach nil))))
  120. (point))
  121. (defun org-w3m-get-prev-link-start ()
  122. "Move cursor to the start of previous link. Return point."
  123. (catch 'reach
  124. (while (previous-single-property-change (point) 'w3m-anchor-sequence)
  125. ;; jump to previous anchor
  126. (goto-char (previous-single-property-change (point) 'w3m-anchor-sequence))
  127. (when (get-text-property (point) 'w3m-href-anchor)
  128. ;; return point when current is valid link
  129. (throw 'reach nil))))
  130. (point))
  131. (defun org-w3m-no-next-link-p ()
  132. "Whether there is no next link after the cursor.
  133. Return t if there is no next link; otherwise, return nil."
  134. (save-excursion
  135. (equal (point) (org-w3m-get-next-link-start))))
  136. (defun org-w3m-no-prev-link-p ()
  137. "Whether there is no previous link after the cursor.
  138. Return t if there is no previous link; otherwise, return nil."
  139. (save-excursion
  140. (equal (point) (org-w3m-get-prev-link-start))))
  141. ;; Install keys into the w3m keymap
  142. (defvar w3m-mode-map)
  143. (defvar w3m-minor-mode-map)
  144. (when (and (boundp 'w3m-mode-map)
  145. (keymapp w3m-mode-map))
  146. (define-key w3m-mode-map "\C-c\C-x\M-w" 'org-w3m-copy-for-org-mode)
  147. (define-key w3m-mode-map "\C-c\C-x\C-w" 'org-w3m-copy-for-org-mode))
  148. (when (and (boundp 'w3m-minor-mode-map)
  149. (keymapp w3m-minor-mode-map))
  150. (define-key w3m-minor-mode-map "\C-c\C-x\M-w" 'org-w3m-copy-for-org-mode)
  151. (define-key w3m-minor-mode-map "\C-c\C-x\C-w" 'org-w3m-copy-for-org-mode))
  152. (add-hook
  153. 'w3m-mode-hook
  154. (lambda ()
  155. (define-key w3m-mode-map "\C-c\C-x\M-w" 'org-w3m-copy-for-org-mode)
  156. (define-key w3m-mode-map "\C-c\C-x\C-w" 'org-w3m-copy-for-org-mode)))
  157. (add-hook
  158. 'w3m-minor-mode-hook
  159. (lambda ()
  160. (define-key w3m-minor-mode-map "\C-c\C-x\M-w" 'org-w3m-copy-for-org-mode)
  161. (define-key w3m-minor-mode-map "\C-c\C-x\C-w" 'org-w3m-copy-for-org-mode)))
  162. (provide 'org-w3m)
  163. ;;; org-w3m.el ends here