org-w3m.el 7.1 KB

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