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