org-w3m.el 7.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183
  1. ;;; org-w3m.el --- Support from copy and paste from w3m to Org-mode
  2. ;; Copyright (C) 2008 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: 6.17a
  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. ;; transfomring 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 ben washed with w3m.
  27. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  28. ;;
  29. ;;; Acknowledgements:
  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. (require 'org)
  36. (declare-function w3m-anchor "ext:w3m-util" (position))
  37. (defgroup org-w3m nil
  38. "Transforming the HTML content in w3m buffer with org-mode style."
  39. :group 'org)
  40. (defcustom org-w3m-deactivate-mark t
  41. "Non-nil means, deactivate mark after copying and region in Org-mode style.
  42. When nil, keep the region active."
  43. :type 'boolean
  44. :group 'org-w3m)
  45. (defun org-w3m-copy-for-org-mode ()
  46. "Copy current buffer content or active region with `org-mode' style links.
  47. This will encode `link-title' and `link-location' with
  48. `org-make-link-string', and insert the transformed test into the kill ring,
  49. so that it can be yanked into an Org-mode buffer with links working correctly."
  50. (interactive)
  51. (let* ((regionp (org-region-active-p))
  52. (transform-start (point-min))
  53. (transform-end (point-max))
  54. return-content
  55. link-location link-title
  56. temp-position out-bound)
  57. (when regionp
  58. (setq transform-start (region-beginning))
  59. (setq transform-end (region-end))
  60. ;; Deactivate mark if current mark is activate.
  61. (if org-w3m-deactivate-mark
  62. (deactivate-mark)))
  63. (message "Transforming links...")
  64. (save-excursion
  65. (goto-char transform-start)
  66. (while (and (not out-bound) ; still inside region to copy
  67. (not (org-w3m-no-next-link-p))) ; no next link current buffer
  68. ;; store current point before jump next anchor
  69. (setq temp-position (point))
  70. ;; move to next anchor when current point is not at anchor
  71. (or (w3m-anchor (point)) (org-w3m-get-next-link-start))
  72. (if (<= (point) transform-end) ; if point is inside transform bound
  73. (progn
  74. ;; get content between two links.
  75. (if (> (point) temp-position)
  76. (setq return-content (concat return-content
  77. (buffer-substring
  78. temp-position (point)))))
  79. ;; get link location at current point.
  80. (setq link-location (w3m-anchor (point)))
  81. ;; get link title at current point.
  82. (setq link-title (buffer-substring (point)
  83. (org-w3m-get-anchor-end)))
  84. ;; concat `org-mode' style url to `return-content'.
  85. (setq return-content (concat return-content
  86. (org-make-link-string
  87. link-location link-title))))
  88. (goto-char temp-position) ; reset point before jump next anchor
  89. (setq out-bound t) ; for break out `while' loop
  90. ))
  91. ;; add the rest until end of the region to be copied
  92. (if (< (point) transform-end)
  93. (setq return-content
  94. (concat return-content
  95. (buffer-substring (point) transform-end))))
  96. (kill-new return-content)
  97. (message "Transforming links...done, use C-y to insert text into Org-mode file")
  98. (message "Copy with link transformation complete."))))
  99. (defun org-w3m-get-anchor-start ()
  100. "Move cursor to the start of current anchor. Return point."
  101. ;; get start position of anchor or current point
  102. (goto-char (or (previous-single-property-change (point) 'w3m-anchor-sequence)
  103. (point))))
  104. (defun org-w3m-get-anchor-end ()
  105. "Move cursor to the end of current anchor. Return point."
  106. ;; get end position of anchor or point
  107. (goto-char (or (next-single-property-change (point) 'w3m-anchor-sequence)
  108. (point))))
  109. (defun org-w3m-get-next-link-start ()
  110. "Move cursor to the start of next link. Return point."
  111. (catch 'reach
  112. (while (next-single-property-change (point) 'w3m-anchor-sequence)
  113. ;; jump to next anchor
  114. (goto-char (next-single-property-change (point) 'w3m-anchor-sequence))
  115. (when (w3m-anchor (point))
  116. ;; return point when current is valid link
  117. (throw 'reach nil))))
  118. (point))
  119. (defun org-w3m-get-prev-link-start ()
  120. "Move cursor to the start of prevoius link. Return point."
  121. (catch 'reach
  122. (while (previous-single-property-change (point) 'w3m-anchor-sequence)
  123. ;; jump to previous anchor
  124. (goto-char (previous-single-property-change (point) 'w3m-anchor-sequence))
  125. (when (w3m-anchor (point))
  126. ;; return point when current is valid link
  127. (throw 'reach nil))))
  128. (point))
  129. (defun org-w3m-no-next-link-p ()
  130. "Whether there is no next link after the cursor.
  131. Return t if there is no next link; otherwise, return nil."
  132. (save-excursion
  133. (equal (point) (org-w3m-get-next-link-start))))
  134. (defun org-w3m-no-prev-link-p ()
  135. "Whether there is no previous link after the cursor.
  136. Return t if there is no previous link; otherwise, return nil."
  137. (save-excursion
  138. (equal (point) (org-w3m-get-prev-link-start))))
  139. ;; Install keys into the w3m keymap
  140. (defvar w3m-mode-map)
  141. (defvar w3m-minor-mode-map)
  142. (when (and (boundp 'w3m-mode-map)
  143. (keymapp w3m-mode-map))
  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. (when (and (boundp 'w3m-minor-mode-map)
  147. (keymapp w3m-minor-mode-map))
  148. (define-key w3m-minor-mode-map "\C-c\C-x\M-w" 'org-w3m-copy-for-org-mode)
  149. (define-key w3m-minor-mode-map "\C-c\C-x\C-w" 'org-w3m-copy-for-org-mode))
  150. (add-hook
  151. 'w3m-mode-hook
  152. (lambda ()
  153. (define-key w3m-mode-map "\C-c\C-x\M-w" 'org-w3m-copy-for-org-mode)
  154. (define-key w3m-mode-map "\C-c\C-x\C-w" 'org-w3m-copy-for-org-mode)))
  155. (add-hook
  156. 'w3m-minor-mode-hook
  157. (lambda ()
  158. (define-key w3m-minor-mode-map "\C-c\C-x\M-w" 'org-w3m-copy-for-org-mode)
  159. (define-key w3m-minor-mode-map "\C-c\C-x\C-w" 'org-w3m-copy-for-org-mode)))
  160. (provide 'org-w3m)
  161. ;; arch-tag: 851d7447-488d-49f0-a14d-46c092e84352
  162. ;;; org-w3m.el ends here